home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / cat / data.i < prev    next >
Text File  |  1997-10-26  |  136KB  |  3,668 lines
  1. IMPLEMENTATION MODULE data;
  2.  
  3. (*$R-,S-*)
  4. (*==============================================================*
  5.  * Modul:               CAT-Datenbank, neue Version             *
  6.  * Autor:               Johannes G”ttker-Schnetmann             *
  7.  * erstellt am:         26.07.1991                              *
  8.  * letzte Žnderung am:  30.10.1993                              *
  9.  * Version:             1.0                                     *
  10.  * Interne Version:     V#0017                                  *
  11.  * Achtung: Muž immer mit $R- bersetzt werden, da R= nicht     *
  12.  * funktioniert!                                                *
  13.  *==============================================================*
  14.  
  15.   Das Modul implementiert eine nach Gruppen getrennte Datenbank fr die 
  16.   Nachrichten der Maus. Weiterhin werden pro Gruppe drei Positionen 
  17.   verwaltet: letzte gelesene Position, Position der ersten neuen Msg und 
  18.   letzte Msg der Datenbank.
  19.   letzte Msg der Datenbank.
  20.  
  21.   In diesem Modul verlasse ich mich erstmal auf die F„higkeit vom
  22.   MM2-Storage, am Programmende alles wieder freizugeben, denn das soll
  23.   es ja gerchteweise k”nnen. Dann kann man sich den dazu n”tigen (redundanten)
  24.   Code sparen!
  25.  
  26.   Weitere Optimierungen: Hashtabelle, intelligentere Pufferung, um auch bei
  27.     wenig Speicher noch Geschwindigkeit zu erreichen
  28.   
  29.  - Hashing-Konzept ist noch nicht auf flexiblere Pufferung vorbereitet,
  30.    die wird aber auch noch nicht benutzt.
  31.  
  32.  - Achtung, bei WriteBlock muž jetzt im Normalfall eine Anpassung der
  33.    crc erfolgen!
  34.  
  35.  *----------------------------------------------------------------------------
  36.  * Datum    Vers. Autor  Žnderung (Arbeitsbericht)                            
  37.  *----------------------------------------------------------------------------
  38.  * 26.07.91 0001  JGS    Erste Version
  39.  * 27.08.91       JGS    Listen einlesen (Gruppenliste, Adressenliste)
  40.  * 28.08.91       JGS    Deklarationen, Konzept..
  41.  * 02.10.91       JGS    Naja, alles m”gliche -> Beginn der Arbeiten -> 11.10
  42.  * 12.10.91 0002  JGS    Lesen sollte jetzt klappen,
  43.  *                       Konzept fr Schreiben angefangen
  44.  * 14.03.92 0003  JGS    erstes Konzept fr den neuen Parameterblock
  45.  * 19.03.92 0004  JGS    Liste der Gruppennamen von aužerhalb erweiterbar
  46.  * 23.03.92 0005  JGS    Diverse Anpassungen, Msgs schreiben angefangen /24.
  47.  * 02.04.92 0006  JGS    Nummer und Position der neuen angepažt
  48.  * 04.04.92 0007  JGS    Anpassung an neue Listendeklaration
  49.  * 06.04.92 0008  JGS    Hashtabelle
  50.  * 08.04.92       JGS    PrepareToWrite/GroupNumber verbessert
  51.  * 15.04.92 0009  JGS    WatchDog-Protokoll/Dupecheck/Statusmeldungen
  52.  * 16.04.92       JGS    ..weiter Statusmeldungen, Dupecheck.., Suchen
  53.  * 24.04.92 0010  JGS   Suchen rckw„rts vorbereitet
  54.  * 04.10.92 0011  JGS   Beginn der Umstellung auf das neue Datenbankformat..
  55.  * 22.10.92 0012  JGS   Neues Format vorl„ufig fertig, Verkettung per RId eingebaut.
  56.  *                      -- etliche Kleinigkeiten --
  57.  * 23.11.92 0013  JGS   Hochsicherheitstrakt, die erste
  58.  * 23/24.12 0014  JGS   Verwaltung der ungelesenen Msgs.
  59.  * 27.12.92       JGS   Verkettung anhand der ersten Msgzeile
  60.  * 31.12.92       JGS   Baum l”schen, Baum durchlaufen
  61.  * 09.01.93 0015  JGS   Vererben-Flag
  62.  * 13.08.93       JGS   Suchroutine auf mehrere Begriffe mit Verknpfungen umgestellt.
  63.  * 02.10.93 0016  JGS   Usenet-Verkettung herstellen
  64.  * 30.10.93 0017  DS    Format der GRUPPEN.POS ge„ndert, ist nun dynamisch
  65.  *----------------------------------------------------------------------------
  66.  *)
  67.  
  68.  
  69. (* MegaMax-Module *)
  70. FROM SYSTEM             IMPORT ADR, TSIZE, ADDRESS, CADR, BYTE, CALLSYS;
  71. FROM Characters         IMPORT CR, LF, SUB;
  72. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  73. IMPORT Lists;
  74. IMPORT Storage;
  75. IMPORT BinOps;
  76. IMPORT Block;
  77. IMPORT StrConv;
  78. IMPORT Strings;
  79.  
  80. (* Cat-Module *)
  81. FROM Void               IMPORT v;
  82. FROM MTPaths            IMPORT DataPath;
  83. (*
  84. FROM TimeService        IMPORT CardToTime, CardToDate;
  85. *)
  86. FROM ZCalcCrc           IMPORT CalcCrc, CalcIdCrc, CalcCrcArray;
  87. FROM UserInformation    IMPORT UserBLK;
  88. FROM CatTypes           IMPORT String1023, Str1023Ptr, DateType, BigTextPtr;
  89. FROM GroupComment       IMPORT PrepareID;
  90. FROM VDIUtil            IMPORT isKey;
  91. IMPORT CatFiles;
  92. IMPORT CatTypes;
  93. IMPORT CatLog;
  94. IMPORT MTE;
  95. IMPORT Hashing2;
  96. (* IMPORT BoyerMoore; *)
  97. IMPORT SearchHelp;
  98. IMPORT Find2;
  99. IMPORT CatGlobal;
  100. IMPORT QuickSort;
  101. IMPORT Varnames;
  102. IMPORT ConfVars;
  103. IMPORT GroupSelect;
  104. IMPORT dataSys;
  105. IMPORT AssFuncs;
  106. IMPORT ConvertDate;
  107. IMPORT WildCards;
  108. IMPORT Protokoll;
  109.  
  110. (* MagicLib *)
  111. IMPORT MagicAES;
  112. IMPORT MagicDOS;
  113. IMPORT MagicStrings;
  114. IMPORT MagicConvert;
  115. IMPORT FileSys;
  116. IMPORT Mintbind;
  117. FROM MagicSys IMPORT lINTEGER;
  118.  
  119. (* MagicTools *)
  120. IMPORT mtAlerts;
  121. IMPORT mtTextfiles;
  122. IMPORT mtAppl;
  123.  
  124.  
  125. (*-- Import der Datenbankstrukturen --*)
  126. FROM dataSys IMPORT
  127.   FileHeaderType, dbHeaderLength, dbCatMagic, dbVersion, dbVersionMagic,
  128.   standardHeader,
  129.   mVon, mAn, mMId, mRId, mBox, mName, mRefNr, mDistribution, mGate, mMime, mReplyTo, mSender, mFollowup, mUnknown, mPrivateBytes,
  130.   dupeInfoPtr, dupeInfoType, Terminator,
  131.   pBlockPtr, pBlock, pInfoPtr, pInfoType, grPosType, posType, maxGroup,
  132.   private, empty, notSaved, personalName, 
  133.   (* Statusbits einer Msg *)
  134.   bGelesen, bFiltered, bInteressant, bTeilloeschung, bTotalloeschung, 
  135.   bKommentieren, bAntworten, bUser1, bUser2, bVererben, 
  136.   (* Vorl„ufig bis bei der Maus die Message-Ids diesen Namen auch verdienen: *)
  137.   bOldDupe, bOwnMessage, bComToOwnMessage, bOldComToOwnMessage;
  138.  
  139. CONST editSecureBytes = 15; (* Wieviele Bytes sollen fr den Editor beim Text zur Sicherheit *)
  140.                             (* zus„tzlich angefordert werden? *)
  141.  
  142. CONST fillBytePersonal = 0314C; (* Fllbyte fr das Alignen der PersonalInfo *)
  143.  
  144. CONST GRInf     = 'gruppen.inf';
  145.       GRPos     = 'gruppen.pos';
  146.       ADRInf    = 'adr.inf';
  147.  
  148.       rawDate   = 'xx.xx.xx xx:xx';
  149.       rawGroupname       = 'gruppe00';
  150.       rawPrivatename     = 'private';
  151.  
  152.       tabTag    = '.tab';
  153.       parTag    = '.par';
  154.       datTag    = '.dat';
  155.       tabWild   = '*.tab';
  156.       parWild   = '*.par';
  157.       allWild   = '*.*';
  158.  
  159.       IDError   = 'ID-Fehler';
  160.  
  161.       additional = 1000; (* Platz fr soviele neue Msgs erstmal vorsehen *)
  162.  
  163. CONST minDatBuffer = 32*1024; (* Erst ab 32k puffern *)
  164.       maxDatBuffer = MAX(CARDINAL)-1; (* bis zu 64k puffern *)
  165.  
  166. TYPE parArray    = ARRAY[0..MAX(CARDINAL)] OF pBlock;
  167.      parArrayPtr = POINTER TO parArray;
  168.      tabArray    = ARRAY[0..MAX(CARDINAL)] OF CARDINAL;
  169.      tabArrayPtr = POINTER TO tabArray;
  170.     
  171.      OneGroupHandle = POINTER TO oneGroupHandle;
  172.      oneGroupHandle =
  173.        RECORD
  174.          group,
  175.          anz            : CARDINAL; (* Anzahl der Nachrichten in dieser Gruppe *)
  176.          tabHandle,
  177.          parHandle,
  178.          datHandle      : INTEGER; (* handles der entsprechenden Dateien *)
  179.          parBuff        : parArrayPtr;  (* Wenn # NIL, dann gepuffert *)
  180.          tabBuff        : tabArrayPtr;  (* dto. *)
  181.          datBuff        : CatTypes.BigTextPtr;
  182.          minPar,      (* erster Parameterblock, der im Speicher steht *)
  183.          ParAnz,      (* maximale Anzahl, die noch im Speicher gehalten werden kann *)
  184.          ParBuffAnz,  (* Anzahl der gepufferten Parameterbl”cke *)
  185.          minTab,      (* erste crc, die im Speicher steht *)
  186.          TabAnz,      (* maximale Anzahl, die im Speicher gehalten werden kann *)
  187.          TabBuffAnz     : CARDINAL; (* Anzahl der gepufferten crcs *)
  188.          DatAnz,      (* Anzahl der belegbaren Bytes im DAT-AppendBuffer *)
  189.          DatBuffAnz     : CARDINAL; (* Anzahl belegte Bytes im DAT-AppendBuffer *)
  190.          DatBuffStart   : LONGCARD; (* Dateiposition, an der der DAT-Buffer beginnt *)
  191.          DatSize        : LONGCARD; (* Gr”že der .DAT zu Testzwecken *)
  192.  
  193.       (* Noch nicht beachtet: *)
  194.          writeThrough   : BOOLEAN; (* trotz Pufferung Schreiboperationen durchlassen *)
  195.          (* Hashing *)
  196.          hash : Hashing2.hashHandle;
  197.          open : BOOLEAN;
  198.          touchlastpos : BOOLEAN; (* Position letzte gelesene neu setzen oder nicht *)
  199.          (* -> evtl. besseres Konzept *)
  200.        END;
  201. (*
  202. TYPE posType   = (aktuellePos, neuePos, letztePos, unreadPos, unreadCount);
  203.      grPosType = 
  204.        RECORD
  205.          head : FileHeaderType;
  206.          save : ARRAY posType OF CARDINAL;
  207.          pos  : POINTER TO ARRAY[0..maxGroup] OF ARRAY[aktuellePos..unreadCount] OF CARDINAL;
  208.          posGroups : CARDINAL;
  209.        END;
  210. *)
  211. (* Die Nummer 0 ist ab sofort die fr die pers”nlichen Msgs, d.h. die Nummerierung auf
  212.  * der Platte stimmt nicht mehr ganz, bleibt aber zun„chst beim alten und muž also
  213.  * fr den Zugriff umgerechnet werden
  214.  *)
  215.  
  216. VAR grPos   : grPosType;
  217. VAR grPosRead : BOOLEAN; (* Wurde die Tabelle schon gelesen? *)
  218. VAR emptyString : ARRAY[0..10] OF CHAR;
  219.  
  220. VAR dangerousDupeMode : BOOLEAN;
  221.     usenetChaining    : BOOLEAN;
  222.     isInSearch        : BOOLEAN;    (* gerade l„uft eine Suche *)
  223.  
  224. PROCEDURE isOldHeader(REF head : FileHeaderType):BOOLEAN;
  225. BEGIN
  226.   WITH head DO
  227.     RETURN
  228.       (CatMagic # dbCatMagic) OR
  229.       (Version # dbVersion) OR
  230.       (VersionMagic # dbVersionMagic);
  231.   END;
  232. END isOldHeader;
  233.  
  234. (*------ Prozeduren fr dynamisches GRUPPEN.POS -------------------*)
  235.  
  236. PROCEDURE CreatePosArray (used: CARDINAL): BOOLEAN;
  237.   VAR i : CARDINAL;
  238.       z : posType;
  239. BEGIN
  240.   grPos.usedGroups := used;
  241.   grPos.posGroups := grPos.usedGroups;
  242.   IF grPos.posGroups < maxGroup - 50
  243.   THEN
  244.     INC (grPos.posGroups, 50);
  245.   ELSE
  246.     grPos.posGroups := maxGroup;
  247.   END;
  248.   (* Jetzt Speicher allozieren *)
  249.   ALLOCATE (grPos.pos, LONG(grPos.posGroups) * TSIZE (dataSys.onePos));
  250.   IF grPos.pos = NIL THEN 
  251.     grPos.usedGroups := 0;
  252.     grPos.posGroups := 0;
  253.     RETURN FALSE 
  254.   END;
  255.   FOR i := 0 TO grPos.posGroups -1 DO
  256.     FOR z := aktuellePos TO unreadCount DO
  257.       grPos.pos^[i, z] := empty
  258.     END;
  259.   END;
  260.   RETURN TRUE;
  261. END CreatePosArray;
  262.  
  263. PROCEDURE GetOnePos (group: CARDINAL; subIdx: dataSys.posType): CARDINAL;
  264. BEGIN
  265.   IF group < grPos.usedGroups
  266.   THEN
  267.     RETURN grPos.pos^[group, subIdx]
  268.   END;
  269.   RETURN empty;
  270. END GetOnePos;
  271.  
  272. PROCEDURE SetOnePos (group: CARDINAL; subIdx: dataSys.posType; value: CARDINAL);
  273.   VAR newSize : CARDINAL;
  274.       newArray: POINTER TO ARRAY [0..maxGroup] OF dataSys.onePos;
  275.       i       : CARDINAL;
  276.       z       : posType;
  277.       wasRead : BOOLEAN;
  278. BEGIN
  279.   wasRead := grPosRead;
  280.   IF ~grPosRead THEN IF ~ReadPos() THEN RETURN END END;
  281.   IF group >= grPos.posGroups 
  282.   THEN
  283.     (* Realloc, Array vergr”žern *)
  284.     IF newSize < maxGroup - 20
  285.     THEN
  286.       newSize := group+20;
  287.     ELSE
  288.       newSize := maxGroup;
  289.     END;
  290.     ALLOCATE (newArray, LONG(newSize) * TSIZE (dataSys.onePos));
  291.     IF newArray = NIL THEN RETURN END;
  292.     Block.Clear (newArray, LONG(newSize) * TSIZE (dataSys.onePos));
  293.     FOR i := grPos.posGroups TO newSize DO
  294.       FOR z := aktuellePos TO unreadCount DO
  295.         grPos.pos^[i, z] := empty
  296.       END;
  297.     END;
  298.     Block.Copy (grPos.pos, LONG(grPos.posGroups) * TSIZE (dataSys.onePos), newArray);
  299.     DEALLOCATE (grPos.pos, 0);
  300.     grPos.posGroups := newSize;
  301.     grPos.pos := ADDRESS(newArray);
  302.   END;
  303.   grPos.usedGroups := BinOps.HigherCard (grPos.usedGroups, group+1);
  304.   grPos.pos^[group, subIdx] := value;
  305. END SetOnePos;
  306.  
  307. (*--- Datumsprozeduren ---*)
  308.  
  309. (*
  310. PROCEDURE GetActualDate(VAR l : LONGCARD);
  311. (* GemDos-Datum in einen Cat-Datums Longcard *)
  312. VAR z1,z2,z3,z4 : CARDINAL;
  313. BEGIN
  314.   z1 := MagicDOS.Tgettime();
  315.   CardToTime(z1,  z2,z3,z4); (* Stunde, Minute, Sekunde *)
  316.   l :=     LONG(z3);               (* Minute *)
  317.   l := l + LONG(z2) * 100;         (* Stunde *)
  318.   z1 := MagicDOS.Tgetdate();
  319.   CardToDate(z1,  z2,z3,z4); (* Jahr, Monat, Tag        *)
  320.   IF z2 >= 1990 THEN DEC(z2, 1990) ELSE z2 := 0 END;
  321.   l := l + LONG(z4) * 10000;       (* Tag    *)
  322.   l := l + LONG(z3) * 1000000;     (* Monat  *)
  323.   l := l + LONG(z2) * 100000000;   (* Jahr   *)
  324. END GetActualDate;
  325. *)
  326.  
  327. PROCEDURE mDateStr2Long(REF str : ARRAY OF CHAR; start : CARDINAL):LONGCARD;
  328. (* Maus-Datumsstring in ein Cat-Datum umwandeln *)
  329. (* Format Jahr|Jahr|Jahr|Jahr|Monat|Monat|Tag|Tag|Stunde|Stunde|Minute|Minute *)
  330. (* Jahr := Jahr - 1990                                              *)
  331. (* Format Jahr|Jahr|Monat|Monat|Tag|Tag|Stunde|Stunde|Minute|Minute *)
  332. VAR year : CARDINAL;
  333.     date : LONGCARD;
  334.     dt2  : LONGCARD;
  335.     pos  : CARDINAL;
  336.     tmp  : ARRAY [0..11] OF CHAR;
  337. (* !!! Evtl. noch ein check, ob's keinen šberlauf gibt.. *)
  338. BEGIN
  339.  (*
  340. (* Minuten *)
  341.   date :=        LONG(ORD(str[11+start]) - ORD('0'));
  342.   date := date + LONG(ORD(str[10+start]) - ORD('0')) * 10;
  343. (* Stunden *)
  344.   date := date + LONG(ORD(str[9+start])  - ORD('0')) * 100;
  345.   date := date + LONG(ORD(str[8+start])  - ORD('0')) * 1000;
  346. (* Tage *)
  347.   date := date + LONG(ORD(str[7+start])  - ORD('0')) * 10000;
  348.   date := date + LONG(ORD(str[6+start])  - ORD('0')) * 100000;
  349. (* Monate *)
  350.   date := date + LONG(ORD(str[5+start])  - ORD('0')) * 1000000;
  351.   date := date + LONG(ORD(str[4+start])  - ORD('0')) * 10000000;
  352.  
  353.   (* Jahre fehlen, sind im Moment unten *)
  354.   date := date + LONG(year) *                    100000000;
  355.   *)
  356. (* Jahre *)
  357.   year :=         ORD(str[3+start]) - ORD('0');
  358.   year := year + (ORD(str[2+start]) - ORD('0')) * 10;
  359.   year := year + (ORD(str[1+start]) - ORD('0')) * 100;
  360.   year := year + (ORD(str[  start]) - ORD('0')) * 1000;
  361.   IF year >= 1990 THEN DEC(year, 1990) ELSE year := 0 END;
  362.   (* Neue Routine *)
  363.   Strings.Copy (str, start+4, 8, tmp, v.bool);
  364.   pos := 0;
  365.   dt2 := StrConv.StrToLCard (tmp, pos, v.bool);
  366.   dt2 := dt2 + LONG(year) *                    100000000;
  367.   IF dt2 < 01010000
  368.   THEN
  369.     (* Es muž mindestens der 1.1.90 sein. *)
  370.     dt2 := 1010000;
  371.   END;
  372.   RETURN dt2;
  373. END mDateStr2Long;
  374.  
  375. (*
  376. PROCEDURE InsertDay(y, m, d : CARDINAL; VAR date : ARRAY OF CHAR);
  377. (* Wochentag an die erste Stringstelle einfgen *)
  378. VAR w   : CARDINAL;
  379.     str : ARRAY[0..3] OF CHAR;
  380.     MM7 : ARRAY[1..12] OF CARDINAL;
  381.     wDays : ARRAY [0..19] OF CHAR;
  382. BEGIN
  383.   MM7[1] := 0;  MM7[2] := 3;  MM7[3] := 3;  MM7[4] := 6;
  384.   MM7[5] := 1;  MM7[6] := 4;  MM7[7] := 6;  MM7[8] := 2;
  385.   MM7[9] := 5;  MM7[10]:= 0;  MM7[11]:= 3;  MM7[12]:= 5;
  386.   IF (y < 1900) OR (y > 1999) THEN
  387.     w := 7
  388.   ELSE
  389.     DEC(y, 1900);
  390.     IF m > 12 THEN m := m MOD 12 + 1; END;      (* verhindert Absturz! *)
  391.     w := ( (y MOD 7) + ((y DIV 4) MOD 7) + MM7[m] + d ) MOD 7;
  392.   END;
  393.   MagicStrings.Assign ('SoMoDiMiDoFrSa??',wDays);
  394.   MagicStrings.Copy(wDays, w*2,2, str);
  395.   MagicStrings.Append(', ', str);
  396.   MagicStrings.Insert(str, date, 0);
  397. END InsertDay;
  398. *)
  399.  
  400. PROCEDURE Long2DateStr(date : LONGCARD; VAR str : ARRAY OF CHAR);
  401. (* Cat-Datum in ein menschenlesbares verwandeln *)
  402. VAR c1, year, y,m,d : CARDINAL;
  403.     dt  : ConvertDate.Date;
  404.     ti  : ConvertDate.Time;
  405.     dstr  : ARRAY [0..40] OF CHAR;
  406. BEGIN
  407.   ConvertDate.CatDate2Datim (date, dt, ti);
  408.   ConvertDate.DateToText (dt, "DD.MM.YY", str);
  409.   ConvertDate.TimeToText (ti, " HH:MM", dstr);
  410.   MagicStrings.Append (dstr, str);
  411.   
  412.   MagicStrings.Copy('MoDiMiDoFrSaSo??', ORD(ConvertDate.WeekDay(dt))*2,2, dstr);
  413.   MagicStrings.Append(', ', dstr);
  414.   MagicStrings.Insert(dstr, str, 0);
  415.   (*
  416.   MagicStrings.Assign (rawDate,str);
  417. (* Jahr *)
  418.   year:= SHORT(date DIV    100000000);
  419.   date:= date MOD          100000000;
  420.   INC(year, 1990);
  421.   y  := year;
  422.   year := year MOD 100;
  423.   str[6] := CHR(year DIV 10 + ORD('0'));  (* 'xx.xx.?x xx:xx' *)
  424.   str[7] := CHR(year MOD 10 + ORD('0'));  (* 'xx.xx.?? xx:xx' *)
  425. (* Monat *)
  426.   c1  := SHORT(date DIV     10000000);
  427.   m   := c1 * 10;
  428.   date:= date MOD           10000000;
  429.   str[3] := CHR(c1 + ORD('0'));           (* 'xx.?x.?? xx:xx' *)
  430.   c1  := SHORT(date DIV      1000000);
  431.   m   := m + c1;
  432.   date:= date MOD            1000000;
  433.   str[4] := CHR(c1 + ORD('0'));           (* 'xx.??.?? xx:xx' *)
  434. (* Tag *)
  435.   c1  := SHORT(date DIV       100000);
  436.   d   := c1 * 10;
  437.   date:= date MOD             100000;
  438.   str[0] := CHR(c1 + ORD('0'));           (* '?x.??.?? xx:xx' *)
  439.   c1  := SHORT(date DIV        10000);
  440.   d   := d + c1;
  441.   date:= date MOD              10000;
  442.   str[1] := CHR(c1 + ORD('0'));           (* '??.??.?? xx:xx' *)
  443. (* Stunde *)
  444.   c1  := SHORT(date DIV         1000);
  445.   date:= date MOD               1000;
  446.   str[9] := CHR(c1 + ORD('0'));           (* '??.??.?? ?x:xx' *)
  447.   c1  := SHORT(date DIV          100);
  448.   date:= date MOD                100;
  449.   str[10] := CHR(c1 + ORD('0'));          (* '??.??.?? ??:xx' *)
  450. (* Minute *)
  451.   c1  := SHORT(date DIV           10);
  452.   date:= date MOD                 10;
  453.   str[12] := CHR(c1 + ORD('0'));          (* '??.??.?? ??:?x' *)
  454.   str[13] := CHR(SHORT(date) + ORD('0')); (* '??.??.?? ??:??' *)
  455.   str[14] := 0C;
  456.   InsertDay(y, m, d, str);
  457.   str[18 (*14*)] := 0C;
  458.   *)
  459. END Long2DateStr;
  460.  
  461. (*
  462. PROCEDURE NameToFile (REF name : ARRAY OF CHAR; REF path, fname : ARRAY OF CHAR):BOOLEAN;
  463. (* wg. mtTextfiles.WriteLine der erste Parameter als VAR.. *)
  464. (* 'name' in angegebene Datei schreiben, fr Absender- und Gruppennamen *)
  465. VAR out : INTEGER;
  466. BEGIN
  467.   out := CatFiles.OpenFile(path, fname, CatFiles.writeFile);
  468.   IF out > 0 THEN
  469.     CatFiles.Seek(0, out, CatFiles.end);
  470.     CatFiles.WriteMuch(LONG(LENGTH(name)), out, ADR(name));
  471.     CatFiles.WriteFile(CR, out); CatFiles.WriteFile(LF, out);
  472.     CatFiles.CloseFile(out);
  473.     RETURN CatFiles.FileError = 0
  474.   ELSE
  475.     MTE.info(MTE.nameNotWritten);
  476.     RETURN FALSE
  477.   END;
  478. END NameToFile;
  479. *)
  480.  
  481. (*--- Listen einlesen ---*)
  482. PROCEDURE AppendToList(VAR list : Lists.List; REF str : ARRAY OF CHAR):BOOLEAN;
  483. (* Ein Listenelement an die angegebene Liste anh„ngen;     *
  484.  * 'spezielle' Stringlisten fr Gruppen- und Absendernamen *)
  485. VAR new : listEntryPtr;
  486.     err  : BOOLEAN;
  487.     l   : CARDINAL;
  488. BEGIN
  489.   l := LENGTH(str);
  490.   Storage.ALLOCATE(new, 6+1+l); (* CARDINAL, CARDINAL, BOOLEAN, String und 0C *)
  491.   err := new = NIL;
  492.   IF ~err THEN
  493.     WITH new^ DO
  494.       len      := l;
  495.       selected := FALSE;
  496.       number   := Lists.NoOfEntries(list)+1; (* wg. private *)
  497.       MagicStrings.Assign(str, gName); (* Mžte nach der Anforderung jetzt gerade passen :-) *)
  498.     END;
  499.     Lists.AppendEntry(list, new, err);
  500. (* !! Freigeben, wenn es nicht geklappt hat? *)
  501.   END;
  502.   RETURN ~err
  503. END AppendToList;
  504.  
  505. TYPE whatsWrong = (nothingWrong, onlyFileNotFound, severeFault);
  506. PROCEDURE ReadList (VAR list : Lists.List; REF fname : ARRAY OF CHAR):whatsWrong;
  507. (* Eine der Namenlisten einlesen *)
  508. VAR in    : mtTextfiles.TEXTFILE;
  509.     err    : BOOLEAN;
  510. (*
  511.     new   : listEntryPtr;
  512.     l     : CARDINAL;
  513. *)
  514.     scrap : String1023;
  515. BEGIN
  516.   err := FALSE; 
  517.   IF err THEN
  518.     MTE.InfoAlert(MTE.noFile1, fname, MTE.noFile2);
  519.     RETURN severeFault;
  520.   ELSIF mtTextfiles.OpenTextfile(fname, mtTextfiles.READ, 32768 , in)
  521.   THEN
  522.     WHILE ~err & ~mtTextfiles.EndofText(in) DO
  523.       mtTextfiles.ReadLine(in, scrap); mtTextfiles.ReadLn(in);
  524.       IF scrap[0] # 0C THEN
  525.         err := ~AppendToList(list, scrap); (* Fehler, falls es nicht geklappt hat *)
  526.       END;
  527.     END;
  528.     mtTextfiles.CloseTextfile(in);
  529.     MTE.noMemWarn(err);
  530.   ELSE
  531.     RETURN onlyFileNotFound
  532.   END;
  533.  
  534. (*
  535.   (* Testausgabe *)
  536.   InOut.WriteLn();
  537.   InOut.WriteString('--- data.Liste-----------------------');
  538.   
  539.   Lists.ResetList(list);
  540.   REPEAT
  541.     new := Lists.NextEntry(list);
  542.     IF new # NIL THEN
  543.       InOut.WriteLn();
  544.       InOut.WriteString(new^.gName);
  545.       InOut.WriteCard(new^.number, 10);
  546.     END;
  547.   UNTIL new = NIL;
  548.   InOut.WriteLn();
  549.   InOut.WriteString('--- End of data.List -----------------');  
  550. *)
  551.  
  552.   IF err THEN
  553.     RETURN severeFault;
  554.   ELSE
  555.     RETURN nothingWrong;
  556.   END;
  557. END ReadList;
  558.  
  559. PROCEDURE ClearList (VAR l: Lists.List; killCarrier: BOOLEAN);
  560.  
  561. VAR   entry: ADDRESS;
  562.  
  563. BEGIN
  564.   Lists.ResetList (l);
  565.   entry := Lists.PrevEntry (l);
  566.   WHILE entry # NIL DO
  567.     Lists.RemoveEntry (l, v.bool);
  568.     DEALLOCATE (entry, 0L);
  569.     entry := Lists.CurrentEntry (l);
  570.   END;
  571.   IF killCarrier THEN Lists.DeleteList (l, v.bool) END;
  572. END ClearList;
  573.  
  574. PROCEDURE InitDataBase():BOOLEAN;                       (* exported *)
  575. (* Initialisieren, Fehlermeldung wird selber ausgegeben *)
  576. VAR err : BOOLEAN;
  577.     file: CatTypes.String255;
  578. BEGIN
  579.   (* Erstmal beide Listen l”schen, falls schon was drin ist *)
  580.   ClearList (names, FALSE);
  581.   
  582.   MagicStrings.Assign (DataPath, file);
  583.   MagicStrings.Append (ADRInf, file);
  584.   err := ReadList (names, file) = severeFault;
  585.  
  586.   err := err OR ~ReadPos();
  587.  
  588.   ConfVars.GetConfDefBool(cDangerousDupeMode, dangerousDupeMode, TRUE);
  589.   ConfVars.GetConfDefBool(cUsenetChaining, usenetChaining, FALSE);
  590.  
  591.   RETURN ~err ;
  592. END InitDataBase;
  593.  
  594. PROCEDURE ResetDataBase();
  595. BEGIN
  596. END ResetDataBase;
  597.  
  598. PROCEDURE CloseBase():BOOLEAN;                          (* exported *)
  599. (* Datenbank schliežen, abmelden am Ende *)
  600. BEGIN
  601.   v.bool := WritePos();
  602.   RETURN TRUE
  603. END CloseBase;
  604.  
  605. PROCEDURE PrepareToWrite();
  606. (* setzt die Positionen so, daž nach dem Einfgen etwas hbsches rauskommt :-) *)
  607. VAR group : CARDINAL; ga : CARDINAL; (* Gruppen-Anzahl *)
  608. BEGIN
  609.   FOR group := 0 TO grPos.posGroups-1 DO
  610.     (* hier ohne SetOnePos, da keine šberschreitung der Grenze auftritt *)
  611.     grPos.pos^[group, neuePos] := empty;
  612.   END;
  613. (* Als regelm„žige Aufr„umaktion *)
  614. END PrepareToWrite;
  615.  
  616. PROCEDURE Number2Name(nr : CARDINAL; VAR name : ARRAY OF CHAR);
  617. (* Aus der Gruppennummer den Namensanfang (ohne Extension) erstellen *)
  618. BEGIN
  619.   IF nr = private THEN
  620.     MagicStrings.Assign(rawPrivatename, name);
  621.   ELSE
  622.     DEC(nr);
  623.     (* Fr den Zugriff auf die Platte ist die Gruppennummer um eins zu verringern *)
  624.     MagicStrings.Assign(rawGroupname, name);
  625.     IF nr > 99 THEN
  626.       name[5] := CHR((nr DIV 100) + ORD('0'));
  627.       nr := nr MOD 100;
  628.     END;
  629.     name[6] := CHR((nr DIV 10) + ORD('0'));
  630.     name[7] := CHR((nr MOD 10) + ORD('0'));
  631.   END;
  632. END Number2Name;
  633.  
  634. PROCEDURE FileLength(file : INTEGER):LONGCARD;
  635. BEGIN
  636.   RETURN MagicDOS.Fseek(0, file, MagicDOS.SeekEnd); (*%%%%%*)
  637. END FileLength;
  638.  
  639. PROCEDURE SearchNCountNew(handle     : OneGroupHandle; 
  640.                           start      : CARDINAL;
  641.                       VAR pos, 
  642.                           count      : CARDINAL; 
  643.                           searchOnly : BOOLEAN);FORWARD;
  644.  
  645. PROCEDURE unreadOk(handle : OneGroupHandle):BOOLEAN;FORWARD;
  646.  
  647. PROCEDURE forceUnreadRefresh(handle : OneGroupHandle);                (* exported *)
  648. (* erste Ungelesene suchen und durchz„hlen *)
  649. BEGIN
  650.   SearchNCountNew(handle, 0, grPos.pos^[handle^.group, unreadPos], 
  651.                              grPos.pos^[handle^.group, unreadCount], FALSE);
  652. END forceUnreadRefresh;
  653.  
  654. PROCEDURE OpenOneGroup(group, add : CARDINAL; wannaWrite : BOOLEAN; VAR new : OneGroupHandle):BOOLEAN;(* exported *)
  655. (* NIL, wenn nicht geklappt *)
  656. (* add gibt an, fr wieviele neue Nachrichten Platz ben”tigt wird *)
  657. VAR name : CatTypes.nameStrType;
  658.     open : CatTypes.nameStrType;
  659.     err  : INTEGER;
  660.     avail,
  661.     alloc,
  662.     len  : LONGCARD;
  663.     head : FileHeaderType;
  664.     
  665.   PROCEDURE Abort();
  666.   (* Falls etwas schiefgeht, wenn alle Dateien offen sind *)
  667.   BEGIN
  668.     CatFiles.ErrorAlert(CatFiles.FileError);
  669.     CatFiles.CloseFile(new^.tabHandle);
  670.     CatFiles.CloseFile(new^.parHandle);
  671.     CatFiles.CloseFile(new^.datHandle);
  672.     DISPOSE(new);
  673.   END Abort;
  674.  
  675.   PROCEDURE writeLog(REF open : ARRAY OF CHAR; error: INTEGER);
  676.     VAR errMsg: CatTypes.String255;
  677.   BEGIN
  678.     CatLog.WriteLine('- Fehler beim ”ffnen von Dateien -');
  679.     CatLog.WriteString('Kein Zugriff auf ');
  680.     CatLog.WriteString(open);
  681.     CatLog.WriteString(' -> Gemdos-Fehler #');
  682.     CatLog.WriteInt(error);
  683.     CatLog.WriteLn();
  684.     CatFiles.GetErrorMsg (error, errMsg);
  685.     CatLog.WriteString ('Fehlermeldung: ');
  686.     CatLog.WriteString (errMsg);
  687.     CatLog.WriteLn();
  688.     CatLog.WriteLine('-Ende der Durchsage -');
  689.   END writeLog;
  690.  
  691. BEGIN
  692.   NEW(new);
  693.   MTE.noMemWarn(new = NIL);
  694.   IF new # NIL THEN
  695.     new^.group := group;
  696.     Number2Name(group, name);
  697.  
  698.     (* Tab-Datei ”ffnen *)
  699.     MagicStrings.Assign(name, open);
  700.     MagicStrings.Append(tabTag, open);
  701.     new^.tabHandle := CatFiles.OpenFile(DataPath, open, CatFiles.readWrite);
  702.     IF new^.tabHandle < 0 THEN 
  703.       DISPOSE(new);
  704.       MTE.InfoAlert(MTE.noFile1, open, MTE.noFile2);
  705.       writeLog(open, CatFiles.FileError);
  706.       RETURN FALSE
  707.     END;
  708.  
  709.     (* Par-Datei ”ffnen *)
  710.     MagicStrings.Assign(name, open);
  711.     MagicStrings.Append(parTag, open);
  712.     new^.parHandle := CatFiles.OpenFile(DataPath, open, CatFiles.readWrite);
  713.     IF new^.parHandle < 0 THEN
  714.       CatFiles.CloseFile(new^.tabHandle);
  715.       DISPOSE(new);
  716.       MTE.InfoAlert(MTE.noFile1, open, MTE.noFile2);
  717.       writeLog(open, CatFiles.FileError);
  718.       RETURN FALSE
  719.     ELSE
  720.       WITH new^ DO
  721.         len := FileLength(parHandle);
  722.         IF len = 0 THEN (* Neue Datei, erstmal den Header schreiben *)
  723.           CatFiles.Seek(0, parHandle, CatFiles.start);
  724.           CatFiles.WriteMuch(dbHeaderLength, parHandle, CADR(standardHeader));
  725.           anz := 0;
  726.         ELSE
  727.           CatFiles.Seek(0, parHandle, CatFiles.start);
  728.           CatFiles.ReadMuch(dbHeaderLength, parHandle, ADR(head));
  729.           IF isOldHeader(head) THEN
  730.             MTE.info(MTE.oldVersion);
  731.             RETURN FALSE;
  732.           END;
  733.           DEC(len, dbHeaderLength);
  734.         END;
  735.         anz := SHORT(len DIV LONG(TSIZE(pBlock)));
  736.         (* Anzahl an Nachrichten in der Gruppe *)
  737.       END;
  738.       IF CatFiles.FileError < 0 THEN
  739.       (* Dann ist beim Lesen des Kopfes oder beim Schreiben etwas schiefgelaufen *)
  740.         writeLog(open, CatFiles.FileError);
  741.         CatFiles.ErrorAlert(CatFiles.FileError);
  742.         CatFiles.CloseFile(new^.tabHandle);
  743.         CatFiles.CloseFile(new^.parHandle);
  744.         DISPOSE(new);
  745.         RETURN FALSE
  746.       END;
  747.     END;
  748.  
  749.     (* Dat-Datei ”ffnen *)
  750.     MagicStrings.Assign(name, open);
  751.     MagicStrings.Append(datTag, open);
  752.     new^.datHandle := CatFiles.OpenFile(DataPath, open, CatFiles.readWrite);
  753.     IF new^.datHandle < 0 THEN
  754.       writeLog(open, CatFiles.FileError);
  755.       CatFiles.CloseFile(new^.tabHandle);
  756.       CatFiles.CloseFile(new^.parHandle);
  757.       DISPOSE(new);
  758.       MTE.InfoAlert(MTE.noFile1, open, MTE.noFile2);
  759.       RETURN FALSE
  760.     ELSE
  761.       new^.DatSize := FileLength (new^.datHandle);
  762.       CatFiles.Seek(0, new^.datHandle, CatFiles.start);
  763.     END;
  764.  
  765.     WITH new^ DO
  766.       SetOnePos (group, letztePos, anz-1);
  767.  
  768.       TabAnz := anz+add;
  769.  
  770.       (* Allozierung nur, wenn genug Speicher frei ist *)
  771.  
  772.       (* Wieviel ist frei *)      
  773.       avail := MagicDOS.Malloc(LONG(-1));
  774.  
  775.       (* Berechnen, was freibleiben soll *)
  776.       avail := avail - (TSIZE(CARDINAL) * LONG (TabAnz));
  777.       IF (TabAnz > 0)
  778.        & (avail > minDatBuffer)
  779.       THEN
  780.         tabBuff      := MagicDOS.Malloc(TSIZE(CARDINAL)*LONG(TabAnz));
  781.       ELSE
  782.         tabBuff := NIL;
  783.       END;
  784.       
  785.       avail := MagicDOS.Malloc(LONG(-1));
  786.  
  787.       (* Berechnen, was freibleiben soll *)
  788.       avail := avail - (TSIZE(pBlock) * LONG (TabAnz));
  789.       IF (TabAnz > 0)
  790.        & (avail > minDatBuffer)
  791.       THEN
  792.         parBuff      := MagicDOS.Malloc(TSIZE(pBlock)*LONG(TabAnz));
  793.       ELSE
  794.         parBuff := NIL;
  795.       END;
  796.  
  797.       ParAnz := TabAnz; (* Das ist erstmal dasselbe *)
  798.  
  799.       minTab := 0;
  800.       minPar := 0; (* More sophisticatet buffering in the future *)
  801.  
  802.       IF (tabBuff # NIL) & (anz > 0) THEN (* und fllen.. *)
  803.         CatFiles.Seek(0, tabHandle, CatFiles.start);
  804.         CatFiles.ReadMuch(TSIZE(CARDINAL)*LONG(anz), tabHandle, tabBuff);
  805.         TabBuffAnz := anz;
  806.         IF CatFiles.FileError < 0 THEN
  807.           v.bool := MagicDOS.Mfree(parBuff);
  808.           v.bool := MagicDOS.Mfree(tabBuff);
  809.           err := CatFiles.FileError;
  810.           Abort();
  811.           writeLog('die crc-Tabelle', err);
  812.           RETURN FALSE;
  813.         END;
  814.       ELSE
  815.         TabBuffAnz   := 0; (* In beiden ist erstmal nichts drin *)
  816.       END;
  817.  
  818.       IF (parBuff # NIL) & (anz > 0) THEN (* und fllen.. *)
  819.         CatFiles.Seek(dbHeaderLength, parHandle, CatFiles.start);
  820.         CatFiles.ReadMuch(LONG(anz)*TSIZE(pBlock), parHandle, parBuff);
  821.         ParBuffAnz := anz;
  822.         IF CatFiles.FileError < 0 THEN
  823.           err := CatFiles.FileError;
  824.           v.bool := MagicDOS.Mfree(parBuff);
  825.           v.bool := MagicDOS.Mfree(tabBuff);
  826.           Abort();
  827.           writeLog('die Parameterdatei', err);
  828.           RETURN FALSE;
  829.         END;
  830.       ELSE
  831.         ParBuffAnz   := 0; (* In beiden ist erstmal nichts drin *)
  832.       END;
  833.  
  834.       IF wannaWrite THEN
  835.         IF tabBuff # NIL THEN
  836.           hash := Hashing2.ToHash(tabBuff, TabBuffAnz, add);
  837.         ELSE
  838.           hash := Hashing2.getEmptyHash()
  839.         END;
  840.         
  841.         datBuff := NIL;
  842.         alloc   := 0;
  843.         REPEAT
  844.           avail := MagicDOS.Malloc(LONG(-1));
  845.           IF avail >= minDatBuffer THEN
  846.             alloc := BinOps.LowerLCard(LONG(maxDatBuffer), avail);
  847.             datBuff := MagicDOS.Malloc(alloc);
  848.           END;
  849.         UNTIL (avail < minDatBuffer) OR (datBuff # NIL);
  850.         IF (avail < minDatBuffer)
  851.          & (datBuff # NIL)
  852.         THEN
  853.           v.bool := MagicDOS.Mfree(datBuff);
  854.           datBuff := NIL;
  855.         ELSE
  856.           DatAnz := BinOps.SwitchCard(datBuff # NIL, SHORT(alloc), 0);
  857.           DatBuffStart := MagicDOS.Fseek(0, datHandle, MagicDOS.SeekEnd);
  858.           DatBuffAnz   := 0;
  859.         END;
  860.  
  861.         IF GetOnePos (group, neuePos) = empty THEN
  862.           SetOnePos (group, neuePos, anz);
  863.         END; (* Das passiert also nur einmal pro Einfgen *)
  864.  
  865.       ELSE (* IF wannaWrite *)
  866.         hash := Hashing2.getEmptyHash();
  867.         datBuff := NIL;
  868.       END;
  869.       (* N”tigenfalls einmal die ungelesenen Msgs durchz„hlen und die erste suchen *)
  870.       IF parBuff # NIL
  871.       THEN
  872.         (* Wenn die PAR gebuffert ist, dann geht das so schnell, das k”nnen wir 
  873.          * immer machen!
  874.          *)
  875.         forceUnreadRefresh(new);
  876.       ELSIF ~unreadOk(new) THEN
  877.         forceUnreadRefresh(new);
  878.       END;
  879.  
  880.       CatLog.WriteStringNTime('Hashtabelle ');
  881.       IF Hashing2.emptyHash(hash) THEN CatLog.WriteString('nicht '); END;
  882.       CatLog.WriteString('angelegt ');
  883.  
  884.       CatLog.WriteString('PAR ');
  885.       IF parBuff = NIL THEN CatLog.WriteString('nicht '); END;
  886.       CatLog.WriteString('gepuffert ');
  887.  
  888.       CatLog.WriteString('TAB ');
  889.       IF tabBuff =  NIL THEN CatLog.WriteString('nicht '); END;
  890.       CatLog.WriteString('gepuffert ');
  891.  
  892.       CatLog.WriteString('DAT ');
  893.       IF datBuff = NIL THEN CatLog.WriteString('nicht '); END;
  894.       CatLog.WriteLine('gepuffert ');
  895.  
  896.       writeThrough := TRUE;
  897.       open         := TRUE;
  898.       touchlastpos := TRUE;
  899.       SetOnePos (group, letztePos, anz-1);
  900.     END; (* WITH new^ *)
  901.  
  902.     (* und evtl. noch ein paar Checks/Fehlerkorrekturen, z.B. letzte Msg *)
  903.     RETURN TRUE
  904.   ELSE
  905.     RETURN FALSE
  906.   END;
  907. END OpenOneGroup;
  908.  
  909. PROCEDURE CloseOneGroup(VAR handle : OneGroupHandle);
  910. (* Gruppe, die zum Lesen ge”ffnet war schliežen *)
  911. BEGIN
  912.   CloseOneWriteGroup(handle, 0, TRUE, v.bool);
  913.   v.bool := WritePos();
  914. END CloseOneGroup;
  915.  
  916. PROCEDURE CloseOneWriteGroup(VAR handle : OneGroupHandle;
  917.                                  newMsg : CARDINAL;
  918.                                  write  : BOOLEAN; 
  919.                              VAR abort  : BOOLEAN);
  920. (* Gruppe, die zum schreiben ge”ffnet war schliežen *)
  921. (* newMsg -> Anzahl der neuen (d.h. nicht gefilterten oder ignorierten) Msgs *)
  922. (* write  -> Puffer wirklich zurckschreiben? Normalerweise nicht bei Abbruch *)
  923. (* abort  -> etwas ist beim Schliežen schiefgelaufen *)
  924.  
  925.   PROCEDURE writeLog(abort : BOOLEAN; REF open : ARRAY OF CHAR);
  926.     VAR errMsg : CatTypes.String255;
  927.   BEGIN
  928.     IF abort THEN
  929.       CatLog.WriteLine('- Fehler beim Schliežen von Dateien -');
  930.       CatLog.WriteString('Kein Schreibzugriff auf ');
  931.       CatLog.WriteString(open);
  932.       CatLog.WriteString(' -> Gemdos-Fehler #');
  933.       CatLog.WriteInt(CatFiles.FileError);
  934.       CatLog.WriteLn();
  935.       CatFiles.GetErrorMsg (CatFiles.FileError, errMsg);
  936.       CatLog.WriteString ('Fehlermeldung: ');
  937.       CatLog.WriteString (errMsg);
  938.       CatLog.WriteLn();
  939.       CatLog.WriteLine('-Ende der Durchsage -');
  940.       CatFiles.ErrorAlert(CatFiles.FileError);
  941.     END;
  942.   END writeLog;
  943.  
  944. BEGIN
  945.   abort := FALSE;
  946.   WITH handle^ DO
  947.     SetOnePos (group, letztePos, anz-1);
  948.     IF (GetOnePos (group, unreadCount) = empty) OR
  949.        (GetOnePos (group, unreadPos) = empty) OR
  950.        (parBuff # NIL) THEN
  951.       forceUnreadRefresh(handle);
  952.     ELSE
  953.       (* Hier auch ohne SetOnePos, da auch hier keine Arrayberschreitung
  954.        * auftreten kann. Wenn es eine gab, dann wurde die schon vorher behoben
  955.        *)
  956.       INC(grPos.pos^[group, unreadCount], newMsg);
  957.     END;
  958.  
  959.   (* Puffer freigeben.. umgekehrte Reihenfolge wie oben *)
  960.     IF datBuff # NIL THEN
  961.       IF write THEN
  962.         CatFiles.Seek(0, datHandle, CatFiles.end);
  963.         CatFiles.WriteMuch(LONG(DatBuffAnz), datHandle, datBuff);
  964.         abort := CatFiles.FileError < 0;
  965.         writeLog(abort, 'die Haupt-Datendatei');
  966.       END;
  967.       v.bool := MagicDOS.Mfree(datBuff);
  968.     END;
  969.  
  970.     IF parBuff # NIL THEN
  971.       IF ~abort & write THEN
  972.         CatFiles.Seek(LONG(minPar)*LONG(TSIZE(pBlock))+dbHeaderLength, parHandle, CatFiles.start);
  973.         CatFiles.WriteMuch(LONG(ParBuffAnz)*TSIZE(pBlock), parHandle, parBuff);
  974.         abort := CatFiles.FileError < 0;
  975.         writeLog(abort, 'die Parameterdatei');
  976.       END;
  977.       v.bool := MagicDOS.Mfree(parBuff)
  978.     END;
  979.  
  980.     IF tabBuff # NIL THEN
  981.       IF ~abort & write THEN
  982.         CatFiles.Seek(2*LONG(minTab), tabHandle, CatFiles.start);
  983.         CatFiles.WriteMuch(2*LONG(TabBuffAnz), tabHandle, tabBuff);
  984.         abort := CatFiles.FileError < 0;
  985.         writeLog(abort, 'die Crc-Tabelle');
  986.       END;
  987.       v.bool := MagicDOS.Mfree(tabBuff)
  988.     END;
  989.  
  990.   (* Dateien schliežen *)
  991.     CatFiles.CloseFile(tabHandle);
  992.     CatFiles.CloseFile(parHandle);
  993.     CatFiles.CloseFile(datHandle);
  994.     
  995.     Hashing2.ReleaseHash(hash);
  996.     
  997.   END;
  998.   DISPOSE(handle);
  999.   handle := NIL;  
  1000. END CloseOneWriteGroup;
  1001.  
  1002. PROCEDURE SetLogDate(VAR date : ARRAY OF CHAR);                 (* exported *)
  1003. (* Datum aus dem Logfile bernehmen *)
  1004. BEGIN
  1005. END SetLogDate;
  1006.  
  1007. PROCEDURE SaveNames ();
  1008. (* Sichert die Liste der Namen komplett 
  1009.  *)
  1010.  VAR file : CatTypes.String255;
  1011.      out  : mtTextfiles.TEXTFILE;
  1012.      num,
  1013.      i    : CARDINAL;
  1014.      entry: listEntryPtr;
  1015. BEGIN
  1016.   MagicStrings.Assign (DataPath, file);
  1017.   MagicStrings.Append (ADRInf, file);
  1018.   IF mtTextfiles.OpenTextfile (file, mtTextfiles.WRITE, 2048, out)
  1019.   THEN
  1020.     num := Lists.NoOfEntries (names);
  1021.     FOR i := 1 TO num  DO
  1022.       Lists.ResetList (names);
  1023.       entry := Lists.NextEntry (names);
  1024.       WHILE (entry # NIL) & (entry^.number # i) DO 
  1025.         entry := Lists.NextEntry (names);
  1026.       END;
  1027.       IF entry # NIL
  1028.       THEN
  1029.         mtTextfiles.WriteLine (out, entry^.gName);
  1030.         mtTextfiles.WriteLn(out);
  1031.       END;
  1032.     END;
  1033.     mtTextfiles.CloseTextfile (out);
  1034.     Protokoll.SendPathUpdate (DataPath);
  1035.   END;
  1036. END SaveNames;
  1037.  
  1038. PROCEDURE AppendName(VAR name : ARRAY OF CHAR);                 (* exported *)
  1039. (* Neuen Absender bernehmen, meckert selber, falls es nicht klappt *)
  1040. BEGIN
  1041.   MTE.noMemWarn(~AppendToList(names, name));
  1042.   v.bool := GroupSelect.NameToFile(name, DataPath, ADRInf);
  1043.   (* Jetzt eventuell noch sortieren *)
  1044.   ConfVars.GetConfDefBool (cSortNames, v.bool, TRUE);
  1045.   IF v.bool THEN
  1046.     SortList (names);
  1047.   END;
  1048. END AppendName;
  1049.  
  1050. PROCEDURE SortList (VAR l : Lists.List);                        (* exported *)
  1051. (* sortiert die Gruppenliste *)
  1052.   VAR count : CARDINAL;
  1053.       sort  : POINTER TO ARRAY [0..$FFFF] OF ADDRESS;
  1054.       i     : CARDINAL;
  1055.       adr   : ADDRESS;
  1056.  
  1057.   PROCEDURE grComp (a1, a2 : ADDRESS) : BOOLEAN;
  1058.     VAR p1, p2 : POINTER TO listEntryPtr;
  1059.         lp1, lp2: listEntryPtr;
  1060.         str1, str2 : CatTypes.String255;
  1061.   BEGIN
  1062.     p1 := a1;
  1063.     p2 := a2;
  1064.     lp1 := p1^;
  1065.     lp2 := p2^;
  1066.     MagicStrings.Assign (lp1^.gName, str1);
  1067.     MagicStrings.Assign (lp2^.gName, str2);
  1068.     MagicStrings.CAPS (str1);
  1069.     MagicStrings.CAPS (str2);
  1070.     RETURN MagicStrings.Compare (str1, str2) = MagicStrings.less;
  1071.   END grComp;
  1072.  
  1073.   PROCEDURE grComp2 (a1, a2 : ADDRESS) : BOOLEAN;
  1074.     VAR p1, p2 : POINTER TO listEntryPtr;
  1075.         lp1, lp2: listEntryPtr;
  1076.         str1, str2 : CatTypes.String255;
  1077.   BEGIN
  1078.     lp1 := a1;
  1079.     lp2 := a2;
  1080.     MagicStrings.Assign (lp1^.gName, str1);
  1081.     MagicStrings.Assign (lp2^.gName, str2);
  1082.     MagicStrings.CAPS (str1);
  1083.     MagicStrings.CAPS (str2);
  1084.     MagicDOS.Cconws (12c+15c+0c);
  1085.     MagicDOS.Cconws (str1);
  1086.     MagicDOS.Cconws (12c+15c+0c);
  1087.     MagicDOS.Cconws (str2);
  1088.     MagicDOS.Cconws (12c+15c+0c);
  1089.     RETURN MagicStrings.Compare (str1, str2) = MagicStrings.less;
  1090.   END grComp2;
  1091.  
  1092. BEGIN
  1093.   (*
  1094.   v.bool := QuickSort.ListSort (l, grComp2, testBreak);
  1095.   *)
  1096.   count := Lists.NoOfEntries (l);
  1097.   IF count = 0 THEN RETURN END;
  1098.   ALLOCATE (sort, LONG(count) * TSIZE (ADDRESS));
  1099.   IF sort = NIL THEN RETURN END;
  1100.   Lists.ResetList (l);
  1101.   FOR i := 0 TO count-1 DO
  1102.     sort^[i] := Lists.NextEntry (l);
  1103.   END;
  1104.   v.bool := QuickSort.sortIt (0, count-1, sort^, grComp, TSIZE (ADDRESS), QuickSort.noBreak);
  1105.   (* Liste wieder zurckbernehmen *)
  1106.   Lists.ResetList (l);
  1107.   FOR i := 0 TO count-1 DO
  1108.     adr := Lists.NextEntry (l);
  1109.     Lists.RemoveEntry (l, v.bool);
  1110.   END;
  1111.   Lists.ResetList (l);
  1112.   FOR i := 0 TO count - 1 DO 
  1113.     Lists.AppendEntry (l, sort^[i], v.bool);
  1114.   END;
  1115.   DEALLOCATE (sort, 0);
  1116. END SortList;
  1117.  
  1118. (*------------------------------------------------------------------------*)
  1119.  
  1120. PROCEDURE ReadPos():BOOLEAN;                                    (* exported *)
  1121. VAR handle : INTEGER; z : CARDINAL; z2 : posType; ready : BOOLEAN;
  1122.     count : CARDINAL;
  1123.     size  : LONGCARD;
  1124.  
  1125.   PROCEDURE exist(REF path, name : ARRAY OF CHAR):BOOLEAN;
  1126.   VAR file : CatTypes.String255;
  1127.       exists: BOOLEAN;
  1128.       
  1129.   BEGIN
  1130.     MagicStrings.Assign(path, file);
  1131.     MagicStrings.Append(name, file);
  1132.     RETURN CatFiles.Exists(file)
  1133.   END exist;
  1134.  
  1135. BEGIN
  1136.   (* Erstmal alten Kram deallozieren *)
  1137.   IF grPos.pos # NIL
  1138.   THEN 
  1139.     DEALLOCATE (grPos.pos, 0);
  1140.   END;
  1141.   handle := CatFiles.OpenFile(DataPath, GRPos, CatFiles.readFile);
  1142.   IF handle > 0 THEN
  1143.     CatFiles.ReadMuch(dataSys.dbHeaderLength, handle, ADR(grPos.head));
  1144.     ready := CatFiles.FileError >= 0;
  1145.   ELSE
  1146.     ready := FALSE;
  1147.   END;
  1148.   IF ready
  1149.   THEN
  1150.     (* Jetzt prfen, welchen Header wir haben *)
  1151.     IF (grPos.head.CatMagic # dbCatMagic) OR
  1152.        (grPos.head.Version # dbVersion) OR
  1153.        ((grPos.head.VersionMagic # dbVersionMagic) &
  1154.         (grPos.head.VersionMagic # dataSys.grPosVersionMagic))
  1155.     THEN
  1156.       MTE.info (MTE.oldVersion);
  1157.       CatFiles.CloseFile(handle);
  1158.       RETURN FALSE
  1159.     END;
  1160.     IF grPos.head.VersionMagic # dataSys.grPosVersionMagic
  1161.     THEN
  1162.       (* Altes Gruppen.POS, konvertieren *)
  1163.       (* wieviele Gruppen haben wir denn? *)
  1164.       grPos.usedGroups := GroupSelect.CountCatGroups();
  1165.       IF ~CreatePosArray (grPos.usedGroups)
  1166.       THEN
  1167.         MTE.noMemAlert();
  1168.         CatFiles.CloseFile(handle);
  1169.         RETURN FALSE
  1170.       END;
  1171.       (* Und jetzt einlesen *)
  1172.       CatFiles.ReadMuch(LONG(grPos.usedGroups) * TSIZE(dataSys.onePos), handle, grPos.pos);
  1173.       (* Savebereich fr Datum noch l”schen *)
  1174.       Block.Clear (ADR(grPos.save), TSIZE (dataSys.onePos));
  1175.     ELSE
  1176.       (* Jetzt mal sehen, wieviele Gruppen darin gespeichert sind *)
  1177.       (* Gr”že feststellen *)
  1178.       CatFiles.Seek (0, handle, CatFiles.end);
  1179.       size := CatFiles.FilePos (handle);
  1180.       CatFiles.Seek (0, handle, CatFiles.start);
  1181.       count := SHORT((size-dataSys.dbHeaderLength) DIV TSIZE (dataSys.onePos));
  1182.       DEC (count);  (* Wegen save-Info *)
  1183.       CatFiles.Seek (dataSys.dbHeaderLength, handle, CatFiles.start);
  1184.       CatFiles.ReadMuch(TSIZE (dataSys.onePos), handle, ADR(grPos.save));
  1185.       ready := ready & (CatFiles.FileError >= 0);
  1186.       (* Jetzt Speicher allozieren *)
  1187.       IF ~CreatePosArray (count)
  1188.       THEN
  1189.         MTE.noMemAlert();
  1190.         CatFiles.CloseFile(handle);
  1191.         RETURN FALSE
  1192.       END;
  1193.       CatFiles.ReadMuch(LONG(count) * TSIZE (dataSys.onePos), handle, grPos.pos);
  1194.       ready := ready & (CatFiles.FileError >= 0);
  1195.     END;
  1196.     CatFiles.CloseFile(handle);
  1197.     MTE.warnAlert(~ready, MTE.noGrPos, '', '');
  1198.   ELSE
  1199.     ready := TRUE;
  1200.     (* Mal sehen, ob der Typ Dateien hat.. *)
  1201.     IF exist(DataPath, 'grupp???.par') OR
  1202.        exist(DataPath, 'grupp???.dat') OR
  1203.        exist(DataPath, 'grupp???.tab') OR
  1204.        exist(DataPath, 'private.par') OR
  1205.        exist(DataPath, 'private.par') OR
  1206.        exist(DataPath, 'private.dat') OR
  1207.        exist(DataPath, 'private.tab')
  1208.     THEN
  1209.       (* ja, er hat eine, dann werden wir ihn mal interviewen *)
  1210.       IF mtAlerts.Alert(2, MTE.possibleOldVersion) = 2 THEN RETURN FALSE END;
  1211.     END;
  1212.     (* Jetzt Default anlegen *)
  1213.     count := GroupSelect.CountCatGroups();
  1214.     IF ~CreatePosArray (count)
  1215.     THEN
  1216.       MTE.noMemAlert();
  1217.       RETURN FALSE
  1218.     END;
  1219.     FOR z := 0 TO grPos.posGroups - 1 DO 
  1220.       FOR z2 := aktuellePos TO unreadCount DO
  1221.         grPos.pos^[z, z2] := empty
  1222.       END;
  1223.     END;
  1224.     grPos.head := standardHeader;
  1225.   END;
  1226.   grPosRead := ready; (* globale Variable fr WritePos *)
  1227.   RETURN grPosRead;
  1228. END ReadPos;
  1229.  
  1230. PROCEDURE WritePos():BOOLEAN;                                   (* exported *)
  1231. (* Positionstabelle einlesen und schreiben *)
  1232. VAR handle : INTEGER;
  1233. BEGIN
  1234.   IF grPosRead THEN
  1235.     handle := CatFiles.CreateFile(DataPath, GRPos);
  1236.     IF handle > 0 THEN
  1237.       grPos.head := standardHeader;
  1238.       grPos.head.VersionMagic := dataSys.grPosVersionMagic;
  1239.       (* Header schreiben *)
  1240.       CatFiles.WriteMuch(dataSys.dbHeaderLength, handle, ADR(grPos.head));
  1241.       (* Save-Bereich schreiben *)
  1242.       CatFiles.WriteMuch(TSIZE(dataSys.onePos), handle, ADR(grPos.save));
  1243.       (* Gruppenbereich schreiben *)
  1244.       CatFiles.WriteMuch(LONG (grPos.usedGroups) * TSIZE(dataSys.onePos), handle, grPos.pos);
  1245.       CatFiles.CloseFile(handle);
  1246.     END;
  1247.     IF (handle < 0) OR (CatFiles.FileError < 0) THEN
  1248.       MTE.info(MTE.postableNotWritten);
  1249.       RETURN FALSE;
  1250.     ELSE
  1251.       RETURN TRUE
  1252.     END;
  1253.   ELSE
  1254.     RETURN TRUE; (* wurde garnicht gelesen! *)
  1255.   END;
  1256. END WritePos;
  1257.  
  1258. (*--- Schutzfunktionen ---*)
  1259.  
  1260. PROCEDURE GetCheckArea (VAR area: dataSys.onePos);
  1261. (* Holt die Prfarea fr das Datum aus dem GRUPPEN.POS
  1262.  *)
  1263. BEGIN
  1264.   area := grPos.save;
  1265. END GetCheckArea;
  1266.  
  1267. PROCEDURE SetCheckArea (area: dataSys.onePos);
  1268. (* Setzt die Prfarea fr das Datum in dem GRUPPEN.POS
  1269.  *)
  1270. BEGIN
  1271.   grPos.save := area;
  1272. END SetCheckArea;
  1273.  
  1274. (*--- Positionsfunktionen ---*)
  1275. PROCEDURE FirstNewMsg(group : CARDINAL):CARDINAL;               (* exported *)
  1276. (* erste Msg aus dem letzten Outfile in dieser Gruppe *)
  1277. BEGIN
  1278.   RETURN GetOnePos (group, neuePos);
  1279. END FirstNewMsg;
  1280.  
  1281. PROCEDURE LastMsgOfGroup(group : CARDINAL):CARDINAL;            (* exported *)
  1282. (* letzte Msg der Gruppe *)
  1283. BEGIN
  1284.   RETURN GetOnePos (group, letztePos);
  1285. END LastMsgOfGroup;
  1286.  
  1287. PROCEDURE lastReadMsgOfGroup(group : CARDINAL):CARDINAL;        (* exported *)
  1288. (* letzte vom User gelesene Msg dieser Gruppe *)
  1289. BEGIN
  1290.   RETURN GetOnePos (group, aktuellePos);
  1291. END lastReadMsgOfGroup;
  1292.  
  1293. PROCEDURE unreadMsgCount(group : CARDINAL):CARDINAL;
  1294. (* Anzahl der ungelesenen Msgs in der Gruppe *)
  1295. BEGIN
  1296.   RETURN GetOnePos (group, unreadCount);
  1297. END unreadMsgCount;
  1298.  
  1299. PROCEDURE unreadMsgPos(group : CARDINAL):CARDINAL;
  1300. (* Position der ersten ungelesenen Msg in der Gruppe *)
  1301. BEGIN
  1302.   RETURN GetOnePos (group, unreadPos);
  1303. END unreadMsgPos;
  1304.  
  1305. PROCEDURE SetLastReadMsg(group, nr : CARDINAL);
  1306. (* neue letzte vom User gelesene Msg setzen *)
  1307. BEGIN
  1308.   SetOnePos (group, aktuellePos, nr);
  1309. END SetLastReadMsg;
  1310.  
  1311. (*--- Zugriffe auf die Datenbank ---*)
  1312.  
  1313. PROCEDURE ReadBlock(handle : OneGroupHandle;
  1314.                     nr     : CARDINAL;
  1315.                 VAR ptr    : pBlockPtr):errorType;
  1316. (* Fr evtl. Pufferung, die ungew”hnliche Deklaration, kein unn”tiges umkopieren *)
  1317. BEGIN
  1318.   WITH handle^ DO
  1319.   IF nr < anz THEN (* echt kleiner! Siehe z.B. eine drin und Nummer 0 lesen *)
  1320.     IF (parBuff # NIL) & (nr >= minPar) & (nr-minPar < ParBuffAnz) THEN
  1321.       ptr := ADR(parBuff^[nr-minPar]); (* H„h„, guter Einfall, nicht? *)
  1322.       CatFiles.FileError := 0;  (* kein Fehler aufgetreten! *)
  1323.     ELSE
  1324.       CatFiles.Seek(LONG(nr)*LONG(TSIZE(pBlock))+dbHeaderLength, parHandle, CatFiles.start);
  1325.       CatFiles.ReadMuch(TSIZE(pBlock), parHandle, ptr);
  1326.     END;
  1327.     IF CatFiles.FileError < 0 THEN
  1328.       RETURN fileError
  1329.     ELSE
  1330.       RETURN noError
  1331.     END;
  1332.   ELSE
  1333.     RETURN notFound
  1334.   END;
  1335.   END; (* WITH handle^ DO *)
  1336. END ReadBlock;
  1337.  
  1338. PROCEDURE ReadBlockCrc(handle : OneGroupHandle;
  1339.                        nr     : CARDINAL;
  1340.                    VAR ptr    : pBlockPtr):errorType;
  1341. (* Block mit crc-Check einlesen *)
  1342. VAR err        : errorType;
  1343.     compareCrc : CARDINAL;
  1344. BEGIN
  1345.   err := ReadBlock(handle, nr, ptr);
  1346.   IF err = noError THEN
  1347.     compareCrc := CalcCrcArray(ptr+ADDRESS(2), SHORT(TSIZE(pBlock))-2);
  1348.     IF compareCrc # ptr^.crc THEN
  1349.       CatFiles.FileError := CatFiles.crcError;
  1350.       RETURN crcError
  1351.     ELSE
  1352.       RETURN noError
  1353.     END;
  1354.   ELSE
  1355.     RETURN err
  1356.   END;
  1357. END ReadBlockCrc;
  1358.  
  1359. PROCEDURE WriteBlock(handle : OneGroupHandle;
  1360.                      nr     : CARDINAL;
  1361.                      ptr    : pBlockPtr);  (* wg. Compiler *)
  1362. (* Fehlerbehandlung..!!! *)
  1363. (* Hier auch einen Pointer bergeben, bei Pufferung einfach nichts machen, wenn *)
  1364. (* der Zeiger schon richtig steht. Die anderen Prozeduren arbeiten im Normalfall *)
  1365. (* mit einem Block, dessen Zeiger sie vielleicht schon von ReadBlock bekommen haben *)
  1366.  
  1367. BEGIN
  1368. (* Debug: Fehler provozieren  IF stopSearch() THEN error := fileError; CatFiles.FileError := -1; RETURN END; *)
  1369. (* writeThrough? *)
  1370.   error := noError;
  1371.   WITH handle^ DO
  1372.   IF nr < anz THEN (* echt kleiner! Siehe z.B. eine drin und Nummer 0 lesen *)
  1373.     IF (parBuff # NIL) & (nr >= minPar) & (nr-minPar < ParBuffAnz) THEN
  1374.       IF ptr # ADR(parBuff^[nr-minPar]) THEN
  1375.         parBuff^[nr-minPar] := ptr^; (* Dann noch zuweisen *)
  1376.       END;
  1377.     ELSE
  1378.       CatFiles.Seek(LONG(nr)*LONG(TSIZE(pBlock))+dbHeaderLength, parHandle, CatFiles.start);
  1379.       CatFiles.WriteMuch(TSIZE(pBlock), parHandle, ptr);
  1380.       IF CatFiles.FileError < 0 THEN
  1381.         error := fileError
  1382.       END;
  1383.     END;
  1384.   ELSE
  1385.     HALT; (* Das sollte n„mlich nicht auftreten.. *)
  1386.   END;
  1387.   END; (* WITH handle^ DO *)
  1388. END WriteBlock;
  1389.  
  1390. PROCEDURE WriteBlockCrc(handle : OneGroupHandle;
  1391.                         nr     : CARDINAL;
  1392.                         ptr    : pBlockPtr);  (* wg. Compiler *)
  1393. BEGIN
  1394.   ptr^.crc := CalcCrcArray(ptr+ADDRESS(2), SHORT(TSIZE(pBlock))-2);
  1395.   WriteBlock(handle, nr, ptr);
  1396. END WriteBlockCrc;
  1397.  
  1398. PROCEDURE AppendBlock(handle : OneGroupHandle; VAR block : pBlock);
  1399. (* Fehlerbehandlung!! *)
  1400. (* Einen Block an PAR anh„ngen *)
  1401. BEGIN
  1402. (* Debug: Fehler provozieren  IF stopSearch() THEN error := fileError; CatFiles.FileError := -1; RETURN END; *)
  1403.  
  1404.   error := noError;
  1405.   WITH handle^ DO
  1406.   IF (parBuff # NIL) & (anz < minPar + ParAnz) & (ParBuffAnz < ParAnz) THEN
  1407.     parBuff^[anz-minPar] := block;
  1408.     INC(ParBuffAnz);
  1409.   ELSE
  1410.     CatFiles.Seek(0, parHandle, CatFiles.end);
  1411.     CatFiles.WriteMuch(TSIZE(pBlock), parHandle, ADR(block));
  1412.     IF CatFiles.FileError < 0 THEN
  1413.       error := fileError
  1414.     END;
  1415.   END;
  1416.   INC(anz); (* Jetzt haben wir einen mehr *)
  1417.   END; (* WITH handle^ DO *)
  1418. END AppendBlock;
  1419.  
  1420. PROCEDURE GetCrc(handle : OneGroupHandle;
  1421.                  nr     : CARDINAL):CARDINAL;
  1422. VAR z : CARDINAL;
  1423. BEGIN
  1424.   error := noError;
  1425.   WITH handle^ DO
  1426.   IF nr < anz THEN (* echt kleiner! Siehe z.B. eine drin und Nummer 0 lesen *)
  1427.     IF (tabBuff # NIL) & (nr >= minTab) & (nr-minTab < TabBuffAnz) THEN
  1428.       z := tabBuff^[nr-minTab]; 
  1429.     ELSE
  1430.       CatFiles.Seek(LONG(nr) * 2, tabHandle, CatFiles.start);
  1431.       CatFiles.ReadMuch(2, tabHandle, ADR(z));
  1432.       IF CatFiles.FileError < 0 THEN
  1433.         error := fileError
  1434.       END;
  1435.     END;
  1436.   ELSE
  1437.     HALT; (* Sollte nicht auftreten *)
  1438.   END;
  1439.   END; (* WITH handle^ DO *)
  1440.   RETURN z
  1441. END GetCrc;
  1442.  
  1443. PROCEDURE AppendCrc(handle : OneGroupHandle; crc : CARDINAL);
  1444. (* Eine Crc an TAB anh„ngen *)
  1445. BEGIN
  1446.   error := noError;
  1447.   WITH handle^ DO
  1448.   IF (tabBuff # NIL) & (anz < minTab + TabAnz) & (TabBuffAnz < TabAnz) THEN
  1449.     tabBuff^[anz-minTab] := crc;
  1450.     INC(TabBuffAnz);
  1451.     Hashing2.AddCrc(hash, crc);
  1452.   ELSE
  1453.     CatFiles.Seek(0, tabHandle, CatFiles.end);
  1454.     CatFiles.WriteMuch(2, tabHandle, ADR(crc));
  1455.     IF CatFiles.FileError < 0 THEN
  1456.       error := fileError
  1457.     END;
  1458.   END;
  1459.   END; (* WITH handle^ DO *)
  1460. END AppendCrc;
  1461.  
  1462. PROCEDURE ReadFromDat(handle : OneGroupHandle;
  1463.                       start,
  1464.                       len    : LONGCARD;
  1465.                       strAdr : ADDRESS);
  1466. BEGIN
  1467.   error := noError;
  1468.   WITH handle^ DO
  1469.   IF (datBuff # NIL) &
  1470.      (start >= DatBuffStart) & (start+len <= DatBuffStart+LONG(DatBuffAnz)) THEN 
  1471.     Block.Copy(ADR(datBuff^[SHORT(start-DatBuffStart)]), len, strAdr);
  1472.   ELSE
  1473.     IF start <= DatSize
  1474.     THEN
  1475.       CatFiles.Seek(start, datHandle, CatFiles.start);
  1476.       CatFiles.ReadMuch(len, datHandle, strAdr);
  1477.       IF CatFiles.FileError < 0 THEN
  1478.         error := fileError
  1479.       END;
  1480.     ELSE
  1481.       error := fileError
  1482.     END;
  1483.   END;
  1484.   END; (* WITH handle^ DO *)
  1485. END ReadFromDat;
  1486.  
  1487. PROCEDURE WriteToDat(handle : OneGroupHandle;
  1488.                       start,
  1489.                       len    : LONGCARD;
  1490.                       strAdr : ADDRESS);
  1491. BEGIN
  1492.   WITH handle^ DO
  1493.     error := noError;
  1494.     CatFiles.Seek(start, datHandle, CatFiles.start);
  1495.     CatFiles.WriteMuch(len, datHandle, strAdr);
  1496.     IF CatFiles.FileError < 0 THEN
  1497.       error := fileError
  1498.     END;
  1499.   END; (* WITH handle^ DO *)
  1500. END WriteToDat;
  1501.  
  1502. PROCEDURE AppendToDat(handle    : OneGroupHandle;
  1503.                      adr       : ADDRESS;
  1504.                      howMuch   : LONGCARD;
  1505.                  VAR startOffs : LONGCARD);
  1506. (* Daten an die DAT anh„ngen *)
  1507. BEGIN
  1508. (* Debug: Fehler provozieren IF stopSearch() THEN error := fileError; CatFiles.FileError := -1; RETURN END; *)
  1509.   error := noError;
  1510.   WITH handle^ DO
  1511.   IF datBuff # NIL THEN
  1512.     IF LONG(DatBuffAnz) + howMuch > LONG(DatAnz) THEN (* Kein Platz mehr *)
  1513.       CatFiles.Seek(0, datHandle, CatFiles.end);
  1514.       CatFiles.WriteMuch(LONG(DatBuffAnz), datHandle, datBuff);
  1515.       INC (DatSize, DatBuffAnz);
  1516.       (* Erstmal den Puffer leeren *)
  1517.       DatBuffAnz := 0;
  1518.       DatBuffStart := MagicDOS.Fseek(0, datHandle, MagicDOS.SeekEnd);
  1519.     END;
  1520.     IF howMuch > LONG(DatAnz) THEN
  1521.     (* Dann ist in jedem Fall auch die obige IF-Bedingung erfllt gewesen! *)
  1522.       startOffs := DatBuffStart;
  1523.       CatFiles.WriteMuch(howMuch, datHandle, adr);
  1524.       INC (DatSize, howMuch);
  1525.     ELSE
  1526.       startOffs := DatBuffStart + LONG(DatBuffAnz);
  1527.       Block.Copy(adr, howMuch, ADR(datBuff^[DatBuffAnz]));
  1528.       INC(DatBuffAnz, SHORT(howMuch));
  1529.     END;
  1530.   ELSE
  1531.     startOffs := MagicDOS.Fseek(0, datHandle, MagicDOS.SeekEnd);
  1532.     CatFiles.WriteMuch(howMuch, datHandle, adr);
  1533.     INC (DatSize, howMuch);
  1534.   END;
  1535.   END; (* WITH handle^ DO *)
  1536.   IF CatFiles.FileError < 0 THEN
  1537.     error := fileError
  1538.   END;
  1539. END AppendToDat;                     
  1540.  
  1541. PROCEDURE ReadID(handle  : OneGroupHandle;
  1542.                  IDStart : LONGCARD;
  1543.                  count   : CARDINAL;
  1544.              VAR id      : ARRAY OF CHAR);
  1545. BEGIN
  1546.   ReadFromDat(handle, IDStart, LONG(count), ADR(id));
  1547. END ReadID;
  1548.  
  1549. PROCEDURE ReadOtherID(handle : OneGroupHandle;
  1550.                       nr     : CARDINAL;
  1551.                   VAR id     : ARRAY OF CHAR;
  1552.                   VAR isOldDupe : BOOLEAN);
  1553. VAR s : pBlock; blockPtr : pBlockPtr;
  1554. BEGIN
  1555.   blockPtr := ADR(s);
  1556.   IF ReadBlock(handle, nr, blockPtr) = noError THEN
  1557.     ReadID(handle, blockPtr^.Start, blockPtr^.idLength, id);
  1558.     isOldDupe := dangerousDupeMode & (bOldDupe IN blockPtr^.bits);
  1559.   ELSE
  1560.     MagicStrings.Assign(IDError, id);
  1561.     isOldDupe := FALSE;
  1562.   END;
  1563. END ReadOtherID;
  1564.  
  1565. PROCEDURE ReadOtherRId(handle : OneGroupHandle;
  1566.                       nr     : CARDINAL;
  1567.                   VAR id     : ARRAY OF CHAR;
  1568.                   VAR isOldDupe : BOOLEAN):BOOLEAN;
  1569. VAR s           : pBlock; 
  1570.     blockPtr    : pBlockPtr;
  1571.     InfoStrings : CatTypes.BigTextPtr;
  1572.     pos         : POINTER TO ARRAY[0..1000] OF CARDINAL;
  1573.     z           : CARDINAL;
  1574.     lauf        : CARDINAL;
  1575.     ptr         : CatTypes.Str255Ptr;
  1576. BEGIN
  1577.   isOldDupe := FALSE;
  1578.   blockPtr  := ADR(s);
  1579.   IF ReadBlock(handle, nr, blockPtr) = noError THEN
  1580.     WITH blockPtr^ DO
  1581.       IF ~(mMId IN items) THEN RETURN FALSE END;
  1582.       Storage.ALLOCATE(InfoStrings, LONG(hLength));
  1583.       IF InfoStrings # NIL THEN
  1584.         ReadFromDat(handle, Start, LONG(hLength), InfoStrings);
  1585.         pos := ADDRESS(InfoStrings) + ADDRESS(LONG(idLength));
  1586.         IF ODD(idLength) THEN INC(pos) END;
  1587.         z := 2;
  1588.         (* Reply-ID ist da in diesem Fall! *)
  1589.         FOR lauf := mVon TO mMId DO
  1590.           IF lauf IN items THEN INC(z) END;
  1591.         END;
  1592.         ptr := ADDRESS(InfoStrings) + ADDRESS(LONG(pos^[z-1]));
  1593.         MagicStrings.Assign(ptr^, id);
  1594.         Storage.DEALLOCATE(InfoStrings, 0L);
  1595.       ELSE
  1596.         RETURN FALSE;
  1597.       END;
  1598.     END;
  1599.     isOldDupe := dangerousDupeMode & (bOldDupe IN blockPtr^.bits);
  1600.   ELSE
  1601.     RETURN FALSE;
  1602.   END;
  1603.   RETURN TRUE;
  1604. END ReadOtherRId;
  1605.  
  1606. PROCEDURE SearchNCountNew(handle     : OneGroupHandle; 
  1607.                           start      : CARDINAL;
  1608.                       VAR pos, 
  1609.                           count      : CARDINAL; 
  1610.                           searchOnly : BOOLEAN);
  1611. (* Datenbank nach der ersten ungelesenen durchsuchen und die ungelesenen durchz„hlen *)
  1612. VAR s : pBlock; blockPtr : pBlockPtr; found : BOOLEAN;
  1613. BEGIN
  1614.   blockPtr := ADR(s); found := FALSE;
  1615.   IF ~searchOnly THEN count := 0 END;
  1616.   WHILE (start <= handle^.anz) & (ReadBlock(handle, start, blockPtr) = noError) DO
  1617.     IF ~(bGelesen IN blockPtr^.bits) THEN
  1618.       IF ~found THEN
  1619.         pos   := start; (* Hier ist die erste ungelesene.. *)
  1620.         found := TRUE;
  1621.       END;
  1622.       IF searchOnly THEN RETURN END; (* alles klar, wir haben einen gefunden.. *)
  1623.       INC(count);
  1624.     END;
  1625.     INC(start);
  1626.     blockPtr := ADR(s);
  1627.   END;
  1628. END SearchNCountNew;
  1629.  
  1630. PROCEDURE unreadOk(handle : OneGroupHandle):BOOLEAN;
  1631. (* "erste ungelesene" berprfen, ob sie wirklich ungelesen ist *)
  1632. VAR s : pBlock; blockPtr : pBlockPtr;
  1633. BEGIN
  1634.   IF (GetOnePos (handle^.group, unreadPos) = empty) OR
  1635.      (GetOnePos (handle^.group, unreadPos) >= handle^.anz) OR
  1636.      (GetOnePos (handle^.group, unreadCount) = empty) OR
  1637.      (GetOnePos (handle^.group, unreadCount) >= handle^.anz) THEN
  1638.     RETURN FALSE
  1639.   END;
  1640.   blockPtr := ADR(s);
  1641.   RETURN (ReadBlock(handle, GetOnePos (handle^.group, unreadPos), blockPtr) = noError) & 
  1642.          ~(bGelesen IN blockPtr^.bits);
  1643. END unreadOk;
  1644.  
  1645. (*--- bestimmte Sachen suchen ---*)
  1646.  
  1647. PROCEDURE SearchID(handle    : OneGroupHandle;
  1648.                REF searchID  : ARRAY OF CHAR;
  1649.                    start     : CARDINAL;
  1650.                    rev       : BOOLEAN;
  1651.                    ignoreOldDupe : BOOLEAN; (* sollen alte Dupes bersprungen werden? *)
  1652.                    (* Normalerweise FALSE *)
  1653.                VAR nr        : CARDINAL):BOOLEAN;
  1654. (* Die Nummer der Nachricht mit der bergebenen ID herausfinden *)
  1655. VAR compareCrc : CARDINAL;
  1656.  
  1657.   PROCEDURE IDOkay():BOOLEAN;
  1658.   VAR scrapID : String1023; isOldDupe : BOOLEAN;
  1659.   BEGIN
  1660.     ReadOtherID(handle, nr, scrapID, isOldDupe);
  1661.     (*
  1662.     RETURN MagicStrings.Equal(scrapID, searchID) & (~ignoreOldDupe OR ~isOldDupe)
  1663.     *)
  1664.     RETURN AssFuncs.CmpId (scrapID, searchID) & (~ignoreOldDupe OR ~isOldDupe)
  1665.   END IDOkay;
  1666.   (* Erl„uterung: Die letzten beiden werden nur verwendet, wenn man im *)
  1667.   (* DangerousDupeMode ist. Ansonsten ist isOldDupe _immer_ FALSE, es  *)
  1668.   (* passiert also nix *)
  1669.  
  1670. BEGIN
  1671.   IF rev
  1672.     THEN IF handle^.anz = 0 THEN RETURN FALSE ELSE nr := handle^.anz-1 END;
  1673.     ELSE nr := start
  1674.   END;
  1675.   compareCrc := CalcIdCrc (searchID);
  1676.   IF Hashing2.emptyHash(handle^.hash) THEN
  1677.     WHILE ( (~rev & (nr < handle^.anz)) OR
  1678.             ( rev & (nr < CARDINAL(-1) )) ) &        (* Das funktioniert *)
  1679.             (CatFiles.FileError >= 0) DO
  1680.        IF (GetCrc(handle, nr) = compareCrc) & IDOkay() & (CatFiles.FileError >= 0) THEN RETURN TRUE END;
  1681.       IF rev THEN DEC(nr) ELSE INC(nr) END
  1682.     END;
  1683.   ELSE
  1684.     nr := Hashing2.GetFirst(handle^.hash, compareCrc);
  1685.     WHILE nr # empty DO
  1686.       IF IDOkay() & (CatFiles.FileError >= 0) THEN RETURN TRUE END;
  1687.       nr := Hashing2.GetNext(handle^.hash);
  1688.     END;
  1689.   END;
  1690.   RETURN FALSE;
  1691. END SearchID;
  1692.  
  1693. (* Fehlerrckgabe der n„chsten 2 Positionsfunktionen: noError/notFound *)
  1694.  
  1695. PROCEDURE NumberOfID(handle : OneGroupHandle;
  1696.                  REF ID     : ARRAY OF CHAR):CARDINAL;          (* exported *)
  1697. (* MsgNummer zu einer ID feststellen *)
  1698. VAR nr : CARDINAL;
  1699. BEGIN
  1700.   IF ID[0] = 0C THEN
  1701.     error := notFound;
  1702.     RETURN empty;
  1703.   ELSIF SearchID(handle, ID, 0, FALSE, TRUE, nr) THEN (* Neueste mit dieser ID finden.. *)
  1704.     error := noError;
  1705.     RETURN nr;
  1706.   ELSE
  1707.     error := notFound;
  1708.     RETURN empty;
  1709.   END;
  1710. END NumberOfID;
  1711.  
  1712. PROCEDURE NumberOfDate(handle : OneGroupHandle;
  1713.                        date   : LONGCARD):CARDINAL;             (* exported *)
  1714. VAR s : pBlock; blockPtr : pBlockPtr; nr : CARDINAL; ok : BOOLEAN;
  1715. BEGIN
  1716.   nr := 0;
  1717.   REPEAT
  1718.     blockPtr := ADR(s);
  1719.     ok := ReadBlock(handle, nr, blockPtr) = noError;
  1720.     INC(nr);
  1721.   UNTIL ~ok OR (nr >= handle^.anz) OR (blockPtr^.Datum >= date);
  1722.   RETURN nr-1
  1723.   (* d.h. evtl. wird hier genau der defekte Block zurckgegeben *)
  1724.   (* crc-error notfalls selber behandeln! *)
  1725. END NumberOfDate;
  1726.  
  1727. (*--- Hilfprozeduren zum lesen ---*)
  1728.  
  1729. PROCEDURE iReadHeader(handle   : OneGroupHandle;
  1730.                       nr       : CARDINAL;
  1731.                       blockPtr : pBlockPtr;
  1732.                   VAR mess     : MessageType);
  1733. (* Fllt mess mit dem, was man aus dem ParameterBlock bekommt,
  1734.  * Eigentlich sind keine Fehler m”glich.. :-)
  1735.  *)
  1736. VAR compareCrc : CARDINAL;
  1737. BEGIN
  1738.   compareCrc := CalcCrcArray(blockPtr+ADDRESS(2), SHORT(TSIZE(pBlock))-2);
  1739.   IF compareCrc # blockPtr^.crc THEN
  1740.     error := crcError;
  1741.     MTE.info(MTE.badMsg);
  1742.     RETURN;
  1743.   END;
  1744.   Block.Clear (ADR(mess), TSIZE (MessageType));
  1745.   WITH mess DO
  1746.     MailNr          := nr;
  1747.     MailAnz         := handle^.anz;
  1748.     MailID          := ADR(emptyString); (* noch nicht bekannt *)
  1749.     KommentierteID  := '';               (* noch nicht bekannt *)
  1750.     fromOther       := FALSE;            (* auch unbekannt *)
  1751.     Betreff         := ADR(emptyString); (* Kommt auch aus der *.dat *)
  1752.     Absender        := ADR(emptyString); (* noch nicht bekannt *)
  1753.     Gruppe          := handle^.group;
  1754.     Long2DateStr(blockPtr^.Datum, Datum);
  1755.     EigeneNachricht := FALSE;
  1756.     StatusDatum     := '';
  1757.  
  1758.     left            := blockPtr^.leftMess;
  1759.     right           := blockPtr^.rightMess;
  1760.     up              := blockPtr^.upMess;
  1761.     down            := blockPtr^.downMess;
  1762.     KommentarAnzahl := blockPtr^.KomCount;
  1763.     tauschDate      := blockPtr^.Datum;
  1764.  
  1765.     infoLen         := blockPtr^.hLength;
  1766.     textLen         := blockPtr^.Length;
  1767.     StatusBits      := blockPtr^.bits;
  1768.     Status          := 'N';
  1769.     statusDate      := 0;
  1770.     Text            := NIL;
  1771.     InfoStrings     := NIL;
  1772.     distribution    := dNone;
  1773.   END;
  1774. END iReadHeader;
  1775.  
  1776. PROCEDURE iReadRest(handle   : OneGroupHandle;
  1777.                     blockPtr : pBlockPtr;
  1778.                     readText : BOOLEAN; (* auch Messagetext einlesen? *)
  1779.                 VAR mess     : MessageType);
  1780. (* Restliche Daten lesen, nur falls bisher alles gut gelesen wurde,
  1781.  * d.h. error = noError
  1782.  *)
  1783. VAR pos  : POINTER TO ARRAY[0..1000] OF CARDINAL;
  1784.  
  1785.   PROCEDURE lauf2Ptr(lauf : CARDINAL; VAR z : CARDINAL);
  1786.   VAR ptr : CatTypes.Str255Ptr; (* ADDRESS, nur fr mRefNr *)
  1787.   BEGIN
  1788.     IF lauf IN blockPtr^.items THEN
  1789.       ptr := ADDRESS(mess.InfoStrings) + ADDRESS(LONG(pos^[z]));
  1790.       INC(z);
  1791.     ELSE
  1792.       ptr := ADR(emptyString);
  1793.     END;
  1794.     CASE lauf OF
  1795.       mVon  : mess.Absender := ptr;
  1796.     | mAn   : mess.Empfaenger := ptr;
  1797.     | mMId  : mess.mid := ptr;
  1798.     | mRId  : mess.rid := ptr;
  1799.     | mBox  : mess.box := ptr;
  1800.     | mName : mess.name := ptr;
  1801.     | mGate : mess.gate := ptr;
  1802.     | mMime : mess.mime := ptr;
  1803.     | mFollowup : mess.followupTo := ptr;
  1804.     | mReplyTo  : mess.replyTo := ptr;
  1805.     | mSender   : mess.sender  := ptr;
  1806.     | mRefNr: MagicStrings.Assign(ptr^, mess.KommentierteID);
  1807.     | mDistribution : IF ptr # NIL THEN 
  1808.                         CASE ptr^[0] OF
  1809.                           'N' : mess.distribution := dNet;
  1810.                         | 'M' : mess.distribution := dMausNet;
  1811.                         | 'L' : mess.distribution := dLokal;
  1812.                         | ELSE mess.distribution  := dNone;
  1813.                         END;
  1814.                       ELSE
  1815.                         mess.distribution := dNone;
  1816.                       END;
  1817.     ELSE
  1818.       HALT
  1819.     END;
  1820.   END lauf2Ptr;
  1821.  
  1822. VAR lauf,
  1823.     z    : CARDINAL;
  1824.     p    : pInfoPtr;
  1825.  
  1826.     cp   : POINTER TO ARRAY[0..SHORT(TSIZE(pInfoType))] OF BYTE;
  1827.     cz   : CARDINAL;
  1828.  
  1829. BEGIN
  1830.   IF error # noError THEN RETURN END;
  1831.   WITH blockPtr^ DO
  1832.     Storage.ALLOCATE(mess.InfoStrings, LONG(hLength));
  1833.     IF mess.InfoStrings # NIL THEN
  1834.       ReadFromDat(handle, Start, LONG(hLength), mess.InfoStrings);
  1835.       mess.MailID  := ADDRESS(mess.InfoStrings);
  1836.       pos := ADDRESS(mess.InfoStrings) + ADDRESS(LONG(idLength));
  1837.       IF ODD(idLength) THEN INC(pos) END;
  1838.       mess.Betreff := ADDRESS(mess.InfoStrings)+ADDRESS(LONG(pos^[1]));
  1839.       z := 2;
  1840.       FOR lauf := mVon TO mSender DO
  1841.         lauf2Ptr(lauf, z);
  1842.       END;
  1843.       IF mPrivateBytes IN items THEN
  1844.         p := mess.InfoStrings + ADDRESS(LONG(hLength) - TSIZE(pInfoType));
  1845.         IF ODD(LONGCARD(p)) THEN
  1846.         (* Speziell fr Datenbanken auf 68000ern, die nicht aligned sind *)
  1847.         (* Davon gibt's nur eine, die von meinem Bruder! *)
  1848.           cp := ADDRESS(p);
  1849.           FOR cz := SHORT(TSIZE(pInfoType)) TO 1 BY -1 DO
  1850.             cp^[cz] := cp^[cz-1];
  1851.           END;
  1852.           INC(p);
  1853.         END;
  1854.         Long2DateStr(p^.LeseDatum, mess.StatusDatum);
  1855.         mess.EigeneNachricht := p^.locked # 0C;
  1856.         mess.Status          := p^.Status;
  1857.         mess.statusDate      := p^.LeseDatum;
  1858.       END;
  1859.     ELSE
  1860.       error := noMemErr;
  1861.       RETURN
  1862.     END;
  1863. (*-- Ist ja jetzt im Header und wird normalerweise von dort geladen! --*)
  1864.     IF (error = noError) & (blockPtr^.upMess # empty) & (blockPtr^.upMess # notSaved)
  1865.        & (blockPtr^.upMess < handle^.anz) & ~(mRefNr IN blockPtr^.items) THEN
  1866.       ReadOtherID(handle, blockPtr^.upMess, mess.KommentierteID, v.bool);
  1867.       (* Nur in diesem Fall von der kommentierten Msg besorgen! *)
  1868.       IF error = noError THEN
  1869.         mess.fromOther := TRUE;
  1870.       ELSE
  1871.         mess.fromOther := FALSE;
  1872.         mess.KommentierteID[0] := 0C;
  1873.       END;
  1874.       error := noError;
  1875.     END;
  1876. (*---------*)
  1877.     IF readText THEN
  1878.       Storage.ALLOCATE(mess.Text, LONG(Length)+editSecureBytes);
  1879.       IF mess.Text # NIL THEN
  1880.         ReadFromDat(handle, Start+LONG(hLength), LONG(Length), mess.Text);
  1881.       ELSE
  1882.         DEALLOCATE(mess.InfoStrings, 0);
  1883.         error := noMemErr;
  1884.       END;
  1885.     ELSE
  1886.     END;
  1887.   END;
  1888. END iReadRest;
  1889.  
  1890. (*--- Leseprozeduren ---*)
  1891. PROCEDURE ReadState(handle : OneGroupHandle; nr : CARDINAL; VAR flags : BITSET);
  1892. (* Nur die Flags lesen, fr "Gelesene ignorieren" *)
  1893. VAR s : pBlock; blockPtr : pBlockPtr;
  1894. BEGIN
  1895.   blockPtr := ADR(s);
  1896.   IF ReadBlockCrc(handle, nr, blockPtr) = noError THEN
  1897.     flags := blockPtr^.bits;
  1898.   ELSE
  1899.     flags := {};
  1900.   END;
  1901. END ReadState;
  1902.  
  1903. PROCEDURE ReadPersState(handle : OneGroupHandle; nr : CARDINAL; VAR state : CHAR; VAR own : BOOLEAN; VAR bits : BITSET);
  1904. (* Nur den Status einer pers”nlichen Msg lesen *)
  1905. VAR s : pBlock; blockPtr : pBlockPtr;
  1906.     pers : pInfoType;
  1907. BEGIN
  1908.   blockPtr := ADR(s);
  1909.   IF ReadBlockCrc(handle, nr, blockPtr) = noError THEN
  1910.     IF (handle^.group = private) THEN
  1911.       CatFiles.Seek(blockPtr^.Start+LONG(blockPtr^.hLength)-TSIZE(pInfoType), handle^.datHandle, CatFiles.start);
  1912.       CatFiles.ReadMuch(TSIZE(pInfoType), handle^.datHandle, ADR(pers));
  1913.       own   := pers.locked # 0C;
  1914.       state := pers.Status;
  1915.     ELSE
  1916.       own   := FALSE;
  1917.       state := '?';
  1918.     END;
  1919.     bits  := blockPtr^.bits;
  1920.     
  1921.     IF (bOldComToOwnMessage IN bits) THEN
  1922.       INCL(bits, bComToOwnMessage);
  1923.       EXCL(bits, bOldComToOwnMessage);
  1924.       blockPtr^.bits := bits;
  1925.       WriteBlockCrc(handle, nr, blockPtr); 
  1926.     END;
  1927.  
  1928.   ELSE
  1929.     own   := FALSE;
  1930.     state := '?';
  1931.     bits  := {};
  1932.   END;
  1933. END ReadPersState;
  1934.  
  1935. PROCEDURE ReadRightNumber(handle : OneGroupHandle; nr : CARDINAL; VAR right : CARDINAL);
  1936. (* Nummer der Nachricht in der Kommentarverkettung nach rechts erfragen *)
  1937. VAR s : pBlock; blockPtr : pBlockPtr;
  1938. BEGIN
  1939.   blockPtr := ADR(s);
  1940.   IF ReadBlockCrc(handle, nr, blockPtr) = noError THEN
  1941.     right := blockPtr^.rightMess;
  1942.   ELSE
  1943.     right := empty;
  1944.   END;
  1945. END ReadRightNumber;
  1946.  
  1947. PROCEDURE HasAnswer(handle : OneGroupHandle; nr : CARDINAL; VAR bits : BITSET):BOOLEAN;
  1948. (* Testet, ob diese Msg noch eine Antwort hat, fr grin.grinResetState *)
  1949. VAR s : pBlock; blockPtr : pBlockPtr;
  1950. BEGIN
  1951.   blockPtr := ADR(s);
  1952.   bits     := {};
  1953.   IF ReadBlockCrc(handle, nr, blockPtr) = noError THEN
  1954.     bits := blockPtr^.bits;
  1955.     RETURN blockPtr^.downMess # empty;
  1956.   ELSE
  1957.     RETURN FALSE
  1958.   END;
  1959. END HasAnswer;
  1960.  
  1961. PROCEDURE ReadText(handle : OneGroupHandle; nr : CARDINAL; adr : ADDRESS);
  1962. (* den Text zur msg in den Puffer lesen, muž natrlich grož genug sein! *)
  1963. VAR s : pBlock; blockPtr : pBlockPtr;
  1964. BEGIN
  1965.   blockPtr := ADR(s);
  1966.   IF ReadBlockCrc(handle, nr, blockPtr) = noError THEN
  1967.     WITH blockPtr^ DO
  1968.       ReadFromDat(handle, Start+LONG(hLength), LONG(Length), adr);
  1969.     END;
  1970.   END;
  1971. END ReadText;
  1972.  
  1973. PROCEDURE iReadMessage(handle : OneGroupHandle;
  1974.                        nr     : CARDINAL;
  1975.                        text   : BOOLEAN; (* Text auch einlesen? *)
  1976.                    VAR mess   : MessageType);
  1977. (* Eine Msg aus der Datenbank lesen *)
  1978. VAR s : pBlock; blockPtr : pBlockPtr;
  1979. BEGIN
  1980.   blockPtr := ADR(s);
  1981.   error    := ReadBlock(handle, nr, blockPtr);
  1982.   IF error = noError THEN
  1983.     iReadHeader(handle, nr, blockPtr, mess);
  1984.     IF error = noError THEN
  1985.       iReadRest(handle, blockPtr, text, mess);
  1986.     END;
  1987.   END;
  1988. END iReadMessage;
  1989.  
  1990. (* M”gliche Fehler: noError, notFound, IOError *)
  1991.  
  1992. PROCEDURE ReadMessage(handle : OneGroupHandle;
  1993.                       nr     : CARDINAL;
  1994.                   VAR mess   : MessageType);                    (* exported *)
  1995. (* Eine Msg aus der Datenbank lesen *)
  1996. BEGIN
  1997.   iReadMessage(handle, nr, TRUE, mess);
  1998. END ReadMessage;
  1999.  
  2000. PROCEDURE ReadHeader(handle : OneGroupHandle; nr : CARDINAL; VAR mess : MessageType);
  2001.                                                                 (* exported *)
  2002. (* Nur einen Teil der Msg lesen, evtl. weitere Funktionen *)
  2003. BEGIN
  2004.   iReadMessage(handle, nr, FALSE, mess);
  2005. END ReadHeader;
  2006.  
  2007. PROCEDURE ReadSmallHeader(handle : OneGroupHandle; nr : CARDINAL; VAR mess : MessageType);
  2008. (* Nur einen Teil der Msg lesen, evtl. weitere Funktionen *)
  2009. VAR s : pBlock; blockPtr : pBlockPtr;
  2010. BEGIN
  2011.   blockPtr := ADR(s);
  2012.   error    := ReadBlock(handle, nr, blockPtr);
  2013.   IF error = noError THEN
  2014.     iReadHeader(handle, nr, blockPtr, mess);
  2015.   END;
  2016. END ReadSmallHeader;
  2017.  
  2018. (*--- Ver„nderungen w„hrend des normalen Lesens ---*)
  2019.  
  2020. PROCEDURE SomethingRead(handle : OneGroupHandle; nr : CARDINAL; newread : BOOLEAN);
  2021. (* group   : Gruppe der Msg *)
  2022. (* nr      : Nummer der Msg *)
  2023. (* newread : Wurde sie neu gelesen oder ungelesen? *)
  2024. (* Wird von SetBits automatisch aufgerufen *)
  2025. VAR start : CARDINAL;
  2026.     posi  : CARDINAL;
  2027. BEGIN
  2028.   IF newread THEN
  2029.     IF GetOnePos(handle^.group, unreadCount) > 0 THEN (* alles klar.. *)
  2030.       SetOnePos (handle^.group, unreadCount, GetOnePos (handle^.group, unreadCount) - 1);
  2031.       start := nr;
  2032.       IF GetOnePos (handle^.group, unreadPos) < start THEN
  2033.         start := GetOnePos (handle^.group, unreadPos)
  2034.       END;
  2035.       (* N„chste ungelesene Msg suchen: *)
  2036.       posi := GetOnePos (handle^.group, unreadPos); 
  2037.       SearchNCountNew(handle, start, posi, v.card, TRUE);
  2038.       SetOnePos (handle^.group, unreadPos, posi)
  2039.     ELSE (* irgendwas stimmt nicht, mal neu z„hlen & suchen *)
  2040.       forceUnreadRefresh(handle);
  2041.     END;
  2042.   END;
  2043. END SomethingRead;
  2044.  
  2045. PROCEDURE SetBits(handle : OneGroupHandle;
  2046.                   nr     : CARDINAL;
  2047.                   bits   : BITSET);                             (* exported *)
  2048. (* Statusbits setzen *)
  2049. VAR s : pBlock; blockPtr : pBlockPtr; newread : BOOLEAN; unread : BOOLEAN;
  2050. BEGIN
  2051.   blockPtr := ADR(s);
  2052.   error := ReadBlock(handle, nr, blockPtr);
  2053.   newread := ~(bGelesen IN blockPtr^.bits) & (bGelesen IN bits);
  2054.   unread := (bGelesen IN blockPtr^.bits) & ~(bGelesen IN bits);
  2055.   blockPtr^.bits := bits;
  2056.  
  2057.   IF (bOldComToOwnMessage IN bits) THEN
  2058.     INCL(bits, bComToOwnMessage);
  2059.     EXCL(bits, bOldComToOwnMessage);
  2060.     blockPtr^.bits := bits;
  2061.     WriteBlockCrc(handle, nr, blockPtr); 
  2062.   END;
  2063.  
  2064.   WriteBlockCrc(handle, nr, blockPtr); (* erst „ndern, ist wichig fr die Suche gleich *)
  2065.   IF newread THEN SomethingRead(handle, nr, TRUE); END;
  2066.   IF unread THEN forceUnreadRefresh (handle) END;
  2067. END SetBits;
  2068.  
  2069. PROCEDURE SetState(handle : OneGroupHandle;
  2070.                     nr     : CARDINAL;
  2071.                     date   : LONGCARD;
  2072.                     State  : CHAR);
  2073. (* StatusChar setzen *)
  2074. VAR s : pBlock; blockPtr : pBlockPtr; p : pInfoType;
  2075. BEGIN
  2076.   blockPtr := ADR(s);
  2077.   error := ReadBlock(handle, nr, blockPtr);
  2078.   IF mPrivateBytes IN blockPtr^.items THEN
  2079.     WITH blockPtr^ DO
  2080.       ReadFromDat(handle, Start+LONG(hLength)-TSIZE(pInfoType), TSIZE(pInfoType), ADR(p));
  2081.       IF (p.Status # State) OR (p.LeseDatum # date) THEN
  2082.         p.Status    := State;
  2083.         p.LeseDatum := date;
  2084.         WriteToDat(handle, Start+LONG(hLength)-TSIZE(pInfoType), TSIZE(pInfoType), ADR(p));
  2085.       END;
  2086.     END; (* WITH blockPtr^ DO *)
  2087.   END;
  2088. END SetState;
  2089.  
  2090. PROCEDURE ChangeState(handle : OneGroupHandle;
  2091.                       nr     : CARDINAL;
  2092.                       NewState : CHAR);                         (* exported *)
  2093. (* StatusChar setzen *)
  2094. VAR l : LONGCARD;
  2095. BEGIN
  2096.   (*
  2097.   GetActualDate(l);
  2098.   *)
  2099.   SetState(handle, nr, ConvertDate.CurrentDate(), NewState);
  2100. (* Was bei Statuswechsel von Z -> G oder Z -> B oder x -> Z ? *)
  2101. END ChangeState;
  2102.  
  2103. (*
  2104. TYPE SearchType = (inBits, inSubject, inText, changeBits, dontShow, reverse);
  2105. (* Die ersten drei geben je an, wo gesucht werden soll. changeBits sagt, *)
  2106. (* daž die Bits der gefundenen Msg gem„ž der Setzmaske gesetzt werden    *)
  2107. (* sollen. Bei dontShow werden alle Msgs bis zum Ende behandlet. Mit     *)
  2108. (* reverse kann man die Suchrichtung auf rckw„rtes stellen              *)
  2109.  
  2110. TYPE SearchSet  = SET OF SearchType;
  2111. *)
  2112.  
  2113. PROCEDURE ComplexSearch(handle  : OneGroupHandle;
  2114.                         start   : CARDINAL;         (* StartNachricht         *)
  2115.                         setBits,
  2116.                         clearBits  : BITSET;        (* Zusammen Suchmaske     *)
  2117.                     VAR str, str2, 
  2118.                         str3, str4 : ARRAY OF CHAR; (* Zu suchender String    *)
  2119.                         wo1, wo2, 
  2120.                         wo3, wo4   : INTEGER;       (* Wo sollen sie stehen?  *)
  2121.                         verkn1, verkn2,
  2122.                         verkn3     : INTEGER;       (* logische Verknpfung   *)
  2123.                         gross      : BOOLEAN;       (* grož=klein?            *)
  2124.                         toSetBits,
  2125.                         toClearBits  : BITSET;      (* Zusammen Setzmaske     *)
  2126.                         what         : SearchSet;   (* Was machen?            *)
  2127.                     VAR break : BOOLEAN;            (* Abbruch durch esc?     *)
  2128.                     VAR nr : CARDINAL):BOOLEAN;     (* Nummer, falls gefunden *)
  2129.  
  2130. (* Sucht eine Nachricht nach den angegebenen Werten, falls sie gefunden wird *)
  2131. (* dann ist found TRUE und es wird die Nummer dieser Nachricht zurckgegeben *)
  2132. (* str wird evtl. wegen grož-klein-Unterscheidung ge„ndert, deswegen         *)
  2133. (* wo1..wo4, verkn1..verkn3 wie in SearchHelp.. *)
  2134. TYPE cardPtrType = POINTER TO ARRAY[0..MAX(CARDINAL)] OF CARDINAL;
  2135.  
  2136. VAR found    : BOOLEAN;
  2137.     s        : pBlock;
  2138.     blockPtr : pBlockPtr;
  2139.     error    : errorType;
  2140.  
  2141. (*    Tabelle  : BoyerMoore.tableType; *)
  2142.     pPatt, pPatt2,
  2143.     pPatt3, pPatt4 : Find2.tpPattern;
  2144.     (* Tabelle der Zeichenpositionen im String (von hinten) *)
  2145.  
  2146.   PROCEDURE isTheEnd(start : CARDINAL):BOOLEAN;
  2147.   (* Hier auch die Anpassung fr Rckw„rtssuche *)
  2148.   BEGIN
  2149.     RETURN ((start >= handle^.anz) & ~(reverse IN what)) OR ((start = $FFFF) & (reverse IN what)); 
  2150.   END isTheEnd;
  2151.  
  2152.   PROCEDURE nextMess(VAR start : CARDINAL);
  2153.   BEGIN
  2154.     IF reverse IN what THEN DEC(start) ELSE INC(start); END;
  2155.   END nextMess;
  2156.  
  2157.   PROCEDURE BitsOk(set, clear, messBits : BITSET; 
  2158.                VAR result : BOOLEAN):BOOLEAN;
  2159.   VAR mask : BITSET;
  2160.   BEGIN
  2161.     mask := set+clear;
  2162.     messBits := messBits - (messBits - mask);
  2163.     result := messBits = set;
  2164.     RETURN result;
  2165.   END BitsOk;
  2166.   
  2167.   PROCEDURE SetBits(set, clear : BITSET; VAR messBits : BITSET);
  2168.   BEGIN
  2169.     IF (changeBits IN what) & ~(ask IN what) THEN
  2170.       messBits := messBits + set;
  2171.       messBits := messBits - clear;
  2172.     END;
  2173.   END SetBits;
  2174.  
  2175.   PROCEDURE stopSearch():BOOLEAN;
  2176.   VAR char, scan : CHAR; kstate : BITSET;
  2177.   BEGIN
  2178.     IF isKey (kstate, scan, char)
  2179.     THEN
  2180.       RETURN char = 33C;
  2181.     END;
  2182.     RETURN FALSE;
  2183.     (*
  2184.     RETURN isKey(kstate, scan, char) & (char = 33C);
  2185.     *)
  2186.   END stopSearch;
  2187.  
  2188.   PROCEDURE CheckWhere(cardPtr    : cardPtrType;
  2189.                        idLength   : CARDINAL;
  2190.                        hLength    : CARDINAL;
  2191.                        bits       : BITSET; 
  2192.                        cond       : INTEGER;
  2193.                        start      : CARDINAL;
  2194.                        len        : CARDINAL):BOOLEAN;
  2195.   (* Testet, ob der String an der gewnschten Stelle steht *)
  2196.  
  2197.   (* Wegen der &%$%$%$%-68000er muss hier eine Sonderbehandlung her, *)
  2198.   (* um ungerade Adressen zu umgehen *)
  2199.   TYPE TrickType = RECORD 
  2200.                      CASE :CARDINAL OF
  2201.                        0 : card : CARDINAL|
  2202.                        1 : byte : ARRAY[0..1] OF BYTE|
  2203.                      END;
  2204.                    END;
  2205.        TrickArray = ARRAY[0..MAX(CARDINAL)] OF BYTE;
  2206.  
  2207.   VAR c : CARDINAL;
  2208.       TrickPointer : POINTER TO TrickArray;
  2209.       t : ARRAY[0..4] OF TrickType;
  2210.   (* Keine L„ngenberprfung, da ein 0C am Ende jedes Stringes steht *)
  2211.   (* Also kann kein gefundener String ber ein Feldende hinausgehen! *)
  2212.   BEGIN
  2213.     TrickPointer := ADDRESS(cardPtr);
  2214.     FOR c := 0 TO 4 DO
  2215.       t[c].byte[0] := TrickPointer^[2*c];
  2216.       t[c].byte[1] := TrickPointer^[2*c+1];
  2217.     END;
  2218. (* evtl. wird hier auf nicht vorhandene Cardinals zugegriffen, das ist aber   *)
  2219. (* nicht weiter tragisch, da die Werte in diesen F„llen auch nicht beachtet   *)
  2220. (* werden! *)
  2221.  
  2222.     CASE cond OF
  2223.       SearchHelp.sUEBERALL     : RETURN (start >= 0) & (start < idLength) OR (start >= idLength + ((*cardPtr^[0]*)t[0].card+1)*2)
  2224.       (* Also in der ID gefunden oder aber hinter der CARDINAL-Tabelle *)
  2225.     | SearchHelp.sTEXT         : RETURN start >= hLength 
  2226.     | SearchHelp.sBETREFF      : RETURN (start >= (*cardPtr^[1]*)t[1].card) & 
  2227.                               ( ((*cardPtr^[0]*)t[0].card >= 2) & (start < (*cardPtr^[2]*)t[2].card) OR
  2228.                                 ((*cardPtr^[0]*)t[0].card <  2) & (start < hLength)
  2229.                               )
  2230.     | SearchHelp.sTEXTnBETREFF : RETURN (start >= (*cardPtr^[1]*)t[1].card) & 
  2231.                               ( ((*cardPtr^[0]*)t[0].card >= 2) & (start < (*cardPtr^[2]*)t[2].card) OR
  2232.                                 ((*cardPtr^[0]*)t[0].card <  2) & (start < hLength)
  2233.                               ) 
  2234.                               OR (start >= hLength)
  2235.     | SearchHelp.sABSENDER     : RETURN 
  2236.                                 (mVon IN bits) & (start >= (*cardPtr^[2]*)t[2].card) & 
  2237.                               ( ((*cardPtr^[0]*)t[0].card >= 3) & (start < (*cardPtr^[3]*)t[3].card) OR
  2238.                                 ((*cardPtr^[0]*)t[0].card <  3) & (start < hLength)
  2239.                               )
  2240.     | SearchHelp.sEMPFAENGER   : IF mVon IN bits THEN c := 3; ELSE c := 2; END;
  2241.                                  (* Position der Startangabe berechnen *)
  2242.                                  RETURN 
  2243.                                  (mAn IN bits) & (start >= (*cardPtr^[c]*)t[c].card) & 
  2244.                               ( ((*cardPtr^[0]*)t[0].card >= c+1) & (start < (*cardPtr^[c+1]*)t[c+1].card) OR
  2245.                                 ((*cardPtr^[0]*)t[0].card <  c+1) & (start < hLength)
  2246.                               )
  2247.     | SearchHelp.sID           : RETURN (start >= 0) & (start < idLength) & (len <= idLength) |
  2248.     END;
  2249.   END CheckWhere;
  2250.   
  2251.   PROCEDURE MakeNewCardPtr (VAR ptr: ADDRESS);
  2252.     VAR count: CARDINAL;
  2253.         bPtr: POINTER TO BYTE;
  2254.         newPtr: ADDRESS;
  2255.   BEGIN
  2256.     bPtr := ptr;
  2257.     count := ORD(bPtr^)*256; INC (bPtr); INC (count, ORD(bPtr^));
  2258.     ALLOCATE (newPtr, (count+1) * TSIZE (CARDINAL));
  2259.     Block.Copy (ptr, (count+1) * TSIZE (CARDINAL), newPtr);
  2260.     ptr := newPtr;
  2261.   END MakeNewCardPtr;
  2262.  
  2263.   PROCEDURE FindWithBits(VAR break : BOOLEAN):BOOLEAN;
  2264.   VAR found : BOOLEAN;
  2265.       helpPtr : ADDRESS; (* BoyerMoore.longPtr; *)
  2266.       cardPtr : ADDRESS;
  2267.       calcLen,
  2268.       datStart   : LONGCARD;
  2269.  
  2270.     PROCEDURE FindWithWhere (Text: ADDRESS; (* Anfangsadresse des zu durchsuchenden Textes *)
  2271.                   TextLen: LONGINT; (* Gesamtl„nge des Textes *)
  2272.                   p      : Find2.tpPattern; (* Zeiger auf vorcompiliertes Suchmuster *)
  2273.                   Start  : LONGINT; (* Such-Startposition im Text *)
  2274.                   wo     : INTEGER
  2275.                   ): BOOLEAN;
  2276.     (* Sucht einen Text mit šberprfung der Fundstelle auf Korrektheit *)
  2277.     (* Achtung: Die Daten zur šberprfung gehen nicht ber die Prozedurschnittstelle! *)
  2278.     VAR found, textfound : BOOLEAN; save : ADDRESS;
  2279.     BEGIN
  2280.       REPEAT
  2281.         textfound := Find2.Find (Text, TextLen, p, 0);
  2282.         found     := textfound & CheckWhere(cardPtr, blockPtr^.idLength, blockPtr^.hLength, blockPtr^.items, wo, 
  2283.                                   SHORT(LONGCARD(p^.pFirst^.pMatch-helpPtr)), LENGTH(str));
  2284.         save      := Text;
  2285.         Text      := p^.pFirst^.pMatch+ADDRESS(1);
  2286.         TextLen   := LONGINT(Text)-LONGINT(save)+1;
  2287.       UNTIL ~textfound OR found;
  2288.       RETURN found;
  2289.     END FindWithWhere;
  2290.  
  2291.   BEGIN
  2292.     REPEAT
  2293.       (* Ist eine zweite REPEAT-Schleife vielleicht besser? *)
  2294.       found    := FALSE; (* gonna be pessimistic today *)
  2295.       blockPtr := ADR(s);
  2296.       error    := ReadBlock(*Crc*)(handle, start, blockPtr);
  2297.       (* Naja, auch mal anpassen, falls wirklich ein bler Fehler auftritt *)
  2298.  
  2299.       (* Erstmal nach einer Message mit den passenden Bits suchen *)
  2300.       WHILE (error = noError) &    (* Suchen solange kein Dateifehler..    *)
  2301.            ~isTheEnd(start) &      (* .. und noch kein Ende erreicht..     *)
  2302.            ~BitsOk(setBits,
  2303.                    clearBits,
  2304.                    blockPtr^.bits,   (* .. sowie die Bits nicht stimmen.   *)
  2305.                    found) DO         (* Dabei das Ergebnis merken.         *)
  2306.       (* erstmal in den Bits suchen, daž geht viel schneller *)
  2307.         nextMess(start);
  2308.         IF ~found & ~isTheEnd(start) THEN
  2309.           blockPtr := ADR(s);
  2310.           error    := ReadBlock(*Crc*)(handle, start, blockPtr);
  2311.         END;
  2312.       END; (* WHILE *)
  2313.       IF found & (*((inSubject IN what) OR *)(inText IN what) THEN
  2314.         (* -- Nachricht laden und durchsuchen *)
  2315.         WITH blockPtr^ DO
  2316.           (* -- L„nge des ben”tigten Blocks berechnen *)
  2317.           calcLen  := LONG(Length)+LONG(hLength);
  2318.           datStart := Start;
  2319.           (* -- Anfordern.. *)
  2320.           Storage.ALLOCATE(helpPtr, calcLen);
  2321.           IF helpPtr # NIL THEN
  2322.             CatGlobal.busyMouse();
  2323.             (*-- laden.. *)
  2324.             ReadFromDat(handle, datStart, calcLen, helpPtr);
  2325.             (* -- und durchsuchen *)
  2326.  
  2327. (*            found := Find2.Find (helpPtr, LONGINT(calcLen), pPatt, 0); *)
  2328.             cardPtr := helpPtr + ADDRESS(LONG(blockPtr^.idLength));
  2329.             IF ODD(blockPtr^.idLength) THEN cardPtr := cardPtr + 1 END;
  2330.             MakeNewCardPtr (cardPtr);
  2331.             (* Zeiger auf die Anfangsoffsets der einzelnen Strings in der Datenbank *)
  2332.  
  2333.             found := FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt, 0, wo1);
  2334.  
  2335.             (* Jetzt noch logische Verknpfungen machen *)
  2336.             IF pPatt2 # NIL THEN
  2337.             (* der erste leere String bricht ab *)
  2338.               IF verkn1 = SearchHelp.vUND THEN
  2339.                 found := found & FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt2, 0, wo2)
  2340.               ELSE
  2341.                 found := found OR FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt2, 0, wo2)
  2342.               END;
  2343.  
  2344.               IF pPatt3 # NIL THEN
  2345.               (* der erste leere String bricht ab *)
  2346.                 IF verkn2 = SearchHelp.vUND THEN
  2347.                   found := found & FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt3, 0, wo3)
  2348.                 ELSE
  2349.                   found := found OR FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt3, 0, wo3)
  2350.                 END;
  2351.  
  2352.                 IF pPatt4 # NIL THEN
  2353.                 (* der erste leere String bricht ab *)
  2354.                   IF verkn3 = SearchHelp.vUND THEN
  2355.                     found := found & FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt4, 0, wo4)
  2356.                   ELSE
  2357.                     found := found OR FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt4, 0, wo4)
  2358.                   END;
  2359.                 END; (* pPatt4 *)
  2360.               END; (* pPatt3 *)
  2361.             END; (* pPatt2 *)
  2362.  
  2363.             (*
  2364.             found := BoyerMoore.Pos(0,
  2365.                                     helpPtr,
  2366.                                     LONGINT(calcLen),
  2367.                                     str,
  2368.                                     LENGTH(str),
  2369.                                     gross,
  2370.                                     Tabelle) <= LONGINT(calcLen);
  2371.              *)
  2372.              Storage.DEALLOCATE(helpPtr, 0);
  2373.              Storage.DEALLOCATE (cardPtr, 0);
  2374.           ELSE
  2375.             MTE.noMemAlert();
  2376.             RETURN FALSE;
  2377.           END;
  2378.         END; (* WITH blockPtr^ *)
  2379.       END;
  2380.       IF found THEN
  2381.         (* Hier werden jetzt die Flags gesetzt! *)
  2382.         SetBits(toSetBits, toClearBits, blockPtr^.bits);
  2383.         WriteBlockCrc(handle, start, blockPtr);
  2384.         IF dontShow IN what THEN
  2385.           found := FALSE; (* hihi *)
  2386.           nextMess(start); (* aktuelle Msg berbl„ttern *)
  2387.         END;
  2388.       ELSE (* Hier kommen wir an, wenn die Bits richtig sind, aber der Text nicht! *)
  2389.         nextMess(start);
  2390.         (* Oben erfolgt auch eine Erh”hung, sogar die wichtigere!        *)
  2391.         (* Hier unten wird die Nachricht berbl„ttert, die zwar richtige *)
  2392.         (* Bits hat, bei der aber der Text falsch ist!                   *)
  2393.       END;
  2394.       break := stopSearch();
  2395.     UNTIL break OR found OR (error # noError) OR isTheEnd(start);
  2396.     RETURN found & ~break;
  2397.   END FindWithBits;
  2398.  
  2399.   PROCEDURE FindStringOnly(VAR break : BOOLEAN):BOOLEAN;
  2400.   CONST buffSize = 64L*1024L;
  2401.   VAR found      : BOOLEAN;
  2402.       helpPtr    : ADDRESS; (* BoyerMoore.longPtr; *)
  2403.       cardPtr    : ADDRESS;
  2404.       freePtr    : ADDRESS; (* BoyerMoore.longPtr; *)
  2405.       amount     : LONGCARD; (* Wieviel wurde gelesen *)
  2406.       startPos   : LONGCARD; (* Startposition in der DAT *)
  2407.       dLen       : LONGCARD; (* Dateil„nge der DAT *)
  2408.  
  2409.       where      : LONGCARD;
  2410.       sLeft,
  2411.       sRight     : CARDINAL;
  2412.       notAgain   : BOOLEAN;
  2413. (*      break      : BOOLEAN; *)
  2414.  
  2415.     PROCEDURE FindWithWhere (Text: ADDRESS; (* Anfangsadresse des zu durchsuchenden Textes *)
  2416.                   TextLen : LONGINT; (* Gesamtl„nge des Textes *)
  2417.                   p       : Find2.tpPattern; (* Zeiger auf vorcompiliertes Suchmuster *)
  2418.                   Start   : LONGINT; (* Such-Startposition im Text *)
  2419.                   wo      : INTEGER
  2420.                   ): BOOLEAN;
  2421.     (* Sucht einen Text mit šberprfung der Fundstelle auf Korrektheit *)
  2422.     (* Achtung: Die Daten zur šberprfung gehen nicht ber die Prozedurschnittstelle! *)
  2423.     VAR found, textfound : BOOLEAN; save : ADDRESS;
  2424.     BEGIN
  2425.       REPEAT
  2426.         textfound := Find2.Find (Text, TextLen, p, 0);
  2427.         found     := textfound & CheckWhere(cardPtr, blockPtr^.idLength, blockPtr^.hLength, blockPtr^.items, wo, 
  2428.                                   SHORT(LONGCARD(p^.pFirst^.pMatch-helpPtr)), LENGTH(str));
  2429.         save      := Text;
  2430.         Text      := p^.pFirst^.pMatch+ADDRESS(1);
  2431.         TextLen   := LONGINT(Text)-LONGINT(save)+1;
  2432.       UNTIL ~textfound OR found;
  2433.       RETURN found;
  2434.     END FindWithWhere;
  2435.  
  2436.   BEGIN
  2437.     Storage.ALLOCATE(freePtr, buffSize);
  2438.     IF freePtr # NIL THEN
  2439.       found := FALSE;
  2440.       dLen := FileLength(handle^.datHandle);
  2441.       blockPtr := ADR(s);
  2442.       error    := ReadBlock(*Crc*)(handle, start, blockPtr);
  2443.       REPEAT (* Suchen bis Abbruch oder gefunden oder am Ende *)
  2444.         (* einlesen *)
  2445.         IF error # noError THEN (* Wenn wir's nicht lesen k”nnen, keine Chance.. *)
  2446.           Storage.DEALLOCATE(freePtr, 0);
  2447.           RETURN FALSE
  2448.         END;
  2449.         WITH blockPtr^ DO
  2450.           IF reverse IN what THEN
  2451.             IF Start+LONG(hLength)+LONG(Length) > buffSize THEN 
  2452.               startPos := Start+LONG(hLength)+LONG(Length) - buffSize;
  2453.             ELSE
  2454.               startPos := 0;
  2455.             END;
  2456.           ELSE
  2457.             startPos := Start;
  2458.           END;
  2459.           amount := BinOps.LowerLCard(buffSize, dLen-startPos);
  2460.           ReadFromDat(handle, startPos, amount, freePtr);
  2461.         END; (* WITH blockPtr^ DO *)
  2462.  
  2463. (* Wir haben hier eine experimentelle Suchfunktion, die noch ein paar     * )
  2464. (* Probleme hat. z.B. muž beim rckw„rts-Suchen BackPos verwendet werden  *)
  2465. (* und es gibt Probleme, wenn das Wort gerade auf Puffergrenzen liegt.    *)
  2466. (* Das kann man dadurch abfangen, daž man bestimmt, zu welcher Msg        *)
  2467. (* das/der Pufferende/-anfang geh”rt und entsprechend dies immer komplett *)
  2468. (* einliest. Mache ich einmal bei Gelegenheit, viel bringt die Routine    *)
  2469. (* bei meine Maxtor sowieso nicht. Aber fr langsame Platten und ohne     *)
  2470. (* Pufferung w„re sie doch bei seltenen Worten deutlich schneller.        *)
  2471. (* Dann kann man auch die Puffergr”že variabel machen, vielleicht anhand  *)
  2472. (* anhand einer Bewertungsfunktion, die aus der L„nge und den Buchstaben  *)
  2473. (* berechnet, wie wahrscheinlich es in einer Msg vorkommen kann. Je       *)
  2474. (* unwahrscheinlicher, desto gr”žer sollte man den Puffer w„hlen.         *)
  2475.  
  2476.  
  2477.         IF handle^.parBuff # NIL THEN
  2478.           (* Wenn die par gepuffert ist, dann einfach den Block durchsuchen *)
  2479.           notAgain := FALSE;
  2480.           REPEAT
  2481.             found := Find2.Find (freePtr, LONGINT(amount), pPatt, 0);
  2482.             (*
  2483.             where := BoyerMoore.Pos(0,
  2484.                                     freePtr,
  2485.                                     LONGINT(amount),
  2486.                                     str,
  2487.                                     LENGTH(str),
  2488.                                     gross,
  2489.                                     Tabelle);
  2490.             found := where <= amount;
  2491.             *)
  2492.             IF ~found THEN
  2493.               IF ~((startPos = 0) & (reverse IN what)) & 
  2494.                  ~(~(reverse IN what) & (startPos + buffSize > dLen)) THEN
  2495.                 IF reverse IN what THEN
  2496.                   IF startPos > buffSize THEN
  2497.                     DEC(startPos, buffSize);
  2498.                   ELSE
  2499.                     startPos := 0;
  2500.                   END
  2501.                 ELSE
  2502.                   IF startPos + buffSize < dLen THEN
  2503.                     INC(startPos, buffSize);
  2504.                   ELSE
  2505.                     startPos := startPos+buffSize-dLen
  2506.                   END;
  2507.                 END;
  2508.                 amount := BinOps.LowerLCard(buffSize, dLen-startPos);
  2509.                 CatGlobal.busyMouse();
  2510.                 ReadFromDat(handle, startPos, amount, freePtr);
  2511.               ELSE
  2512.                 notAgain := TRUE;
  2513.               END;
  2514.             END;
  2515.           UNTIL found OR notAgain;
  2516.           (* Ok, im aktuellen Block steht jetzt m”glicherweise das Wort: *)
  2517.           IF found THEN
  2518.             (* Jetzt bin„r die Msg finden, fr die Start <= startPos+where<Start+hLength+Length *)
  2519.             IF blockPtr^.Start+LONG(blockPtr^.hLength)+LONG(blockPtr^.Length) < startPos + where THEN
  2520.               (* Gesuchte Stelle ist weiter vorne! *)
  2521.               sLeft := start; sRight := handle^.anz-1; (* In leeren Gruppen kann man sowieso nicht suchen *)
  2522.             ELSIF blockPtr^.Start > startPos + where THEN
  2523.               (* Gesuchte Stelle ist weiter hinten! *)
  2524.               sLeft := 0; sRight := start;
  2525.             END;
  2526.             REPEAT
  2527.               IF blockPtr^.Start+LONG(blockPtr^.hLength)+LONG(blockPtr^.Length) < startPos + where THEN
  2528.                 (* Gesuchte Stelle ist weiter vorne! *)
  2529.                 sLeft := start;
  2530.                 start := (sLeft+sRight) DIV 2;
  2531.                 IF start = sLeft THEN INC(start) END;
  2532.               ELSIF blockPtr^.Start > startPos + where THEN
  2533.                 (* Gesuchte Stelle ist weiter hinten! *)
  2534.                 sRight := start;
  2535.                 start  := (sLeft+sRight) DIV 2;
  2536.                 IF start = sRight THEN DEC(start) END;
  2537.               END;
  2538.               blockPtr := ADR(s);
  2539.               error    := ReadBlock(*Crc*)(handle, start, blockPtr);
  2540.             UNTIL (blockPtr^.Start <= startPos+where) &
  2541.                   (startPos+where <= blockPtr^.Start+LONG(blockPtr^.hLength)+LONG(blockPtr^.Length));
  2542.             (* Anschliežend muž in "start" die Nummer dieser Msg stehen! *)
  2543.           END;
  2544.           Storage.DEALLOCATE(freePtr, 0);
  2545.           RETURN found;
  2546.         ELSE
  2547. ( * Ende der experimentellen Suchfunktion *)
  2548.  
  2549.           (* "Alte" Suchfunktion, jetzt auch recht schnell & sicher *)
  2550.           REPEAT (* Msgs im Puffer einzeln durchsuchen *)
  2551.             IF error # noError THEN
  2552.               (* Wenn wir's nicht lesen k”nnen, keine Chance.. *)
  2553.               (* hier, da am Ende der Schleife ein neuer Block gelesen wird *)
  2554.               Storage.DEALLOCATE(freePtr, 0);
  2555.               RETURN FALSE
  2556.             END;
  2557.             helpPtr := freePtr+ADDRESS(blockPtr^.Start-startPos);
  2558.             cardPtr := helpPtr + ADDRESS(LONG(blockPtr^.idLength));
  2559.             IF ODD(blockPtr^.idLength) THEN cardPtr := cardPtr + 1 END;
  2560.             (* Jetzt die Bytes mit den L„ngen (Offsets) einfach kopieren, so
  2561.              * daž kein Buserror auftritt
  2562.              *)
  2563.             MakeNewCardPtr (cardPtr);
  2564.             (* Zeiger auf die Anfangsoffsets der einzelnen Strings in der Datenbank *)
  2565.             
  2566.             found := FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt, 0, wo1);
  2567.  
  2568.             (* Jetzt noch logische Verknpfungen machen *)
  2569.             IF pPatt2 # NIL THEN
  2570.             (* der erste leere String bricht ab *)
  2571.               IF verkn1 = SearchHelp.vUND THEN
  2572.                 found := found & FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt2, 0, wo2)
  2573.               ELSE
  2574.                 found := found OR FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt2, 0, wo2)
  2575.               END;
  2576.  
  2577.               IF pPatt3 # NIL THEN
  2578.               (* der erste leere String bricht ab *)
  2579.                 IF verkn2 = SearchHelp.vUND THEN
  2580.                   found := found & FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt3, 0, wo3)
  2581.                 ELSE
  2582.                   found := found OR FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt3, 0, wo3)
  2583.                 END;
  2584.  
  2585.                 IF pPatt4 # NIL THEN
  2586.                 (* der erste leere String bricht ab *)
  2587.                   IF verkn3 = SearchHelp.vUND THEN
  2588.                     found := found & FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt4, 0, wo4)
  2589.                   ELSE
  2590.                     found := found OR FindWithWhere (helpPtr, LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)), pPatt4, 0, wo4)
  2591.                   END;
  2592.                 END; (* pPatt4 *)
  2593.               END; (* pPatt3 *)
  2594.             END; (* pPatt2 *)
  2595.             
  2596.             (* Speicher fr CardArray wieder freigeben *)
  2597.             DEALLOCATE (cardPtr, 0);
  2598.  
  2599.             (*
  2600.             found := BoyerMoore.Pos(0,
  2601.                                     helpPtr,
  2602.                                     LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)),
  2603.                                     str,
  2604.                                     LENGTH(str),
  2605.                                     gross,
  2606.                                     Tabelle) <= LONGINT(LONG(blockPtr^.Length)+LONG(blockPtr^.hLength));
  2607.             *)
  2608.             IF found THEN
  2609.               (* Hier werden jetzt die Flags gesetzt! *)
  2610.               SetBits(toSetBits, toClearBits, blockPtr^.bits);
  2611.               WriteBlockCrc(handle, start, blockPtr);
  2612.               IF dontShow IN what THEN
  2613.                 found := FALSE; (* hihi *)
  2614.               (*  nextMess(start); *)
  2615.               END;
  2616.             END;
  2617.             (* Die Sache mit nextMess kann man nicht vereinfachen, da start wichtig ist: *)
  2618.             (* Returnwert fr die Nummer der gefundenen Nachricht                        *)
  2619.             IF ~found THEN
  2620.               nextMess(start);
  2621.               IF ~isTheEnd(start) THEN
  2622.                 blockPtr := ADR(s);
  2623.                 IF start MOD 100 = 0 THEN CatGlobal.busyMouse(); END;
  2624.                 error    := ReadBlock(*Crc*)(handle, start, blockPtr);
  2625.               END;
  2626.             END;
  2627.           UNTIL found OR isTheEnd(start) OR
  2628.                 (((blockPtr^.Start + LONG(blockPtr^.Length)+LONG(blockPtr^.hLength)) > startPos+amount) & ~(reverse IN what)) OR
  2629.                 ((blockPtr^.Start < startPos) & (reverse IN what));
  2630.          (* Wenn beim vorw„rts-Suchen das Ende der Msg nicht mehr drin liegt, oder
  2631.             beim rckw„rts suchen der Anfang nicht mehr ist diese Schleife zuende *)
  2632. (* wg. experimenteller Suchfunktion * )
  2633.       END; (* IF handle^.parBuff # NIL *)
  2634. ( * bis hier *)
  2635.       
  2636.       break := stopSearch();
  2637.       UNTIL break OR found OR isTheEnd(start); (* oben n„chsten Puffer einlesen *)
  2638.       Storage.DEALLOCATE(freePtr, 0);
  2639.     ELSE
  2640.       MTE.noMemAlert();
  2641.       RETURN FALSE;
  2642.     END;
  2643.     RETURN found & ~break;
  2644.   END FindStringOnly;
  2645.  
  2646. BEGIN
  2647.   IF isInSearch THEN RETURN FALSE END;
  2648.   IF start >= handle^.anz THEN RETURN FALSE END;
  2649.   (* Damit wollen wir doch garnicht erst anfangen.. tststs *)
  2650.   isInSearch := TRUE;
  2651.   IF (inText IN what) (*OR (inSubject IN what)*) THEN
  2652. (*    BoyerMoore.InitTable(Tabelle, str, LENGTH(str), gross, FALSE); *)
  2653.     pPatt  := Find2.Compile (str,  '?', 1C, '*', 12C, gross, FALSE);
  2654.     IF str2[0] = 0C THEN pPatt2 := NIL ELSE
  2655.       pPatt2 := Find2.Compile (str2, '?', 1C, '*', 12C, gross, FALSE);
  2656.     END;
  2657.     IF str3[0] = 0C THEN pPatt3 := NIL ELSE
  2658.       pPatt3 := Find2.Compile (str3, '?', 1C, '*', 12C, gross, FALSE);
  2659.     END;
  2660.     IF str4[0] = 0C THEN pPatt4 := NIL ELSE
  2661.       pPatt4 := Find2.Compile (str4, '?', 1C, '*', 12C, gross, FALSE);
  2662.     END;
  2663.   ELSE
  2664.     pPatt := NIL; pPatt2 := NIL; pPatt3 := NIL; pPatt4 := NIL;
  2665.   END; (* Tabelle fr sp„tere Suche initialisieren *)
  2666.   mtAppl.StoreMouse();
  2667.   CatGlobal.busyMouse();
  2668.   IF CatGlobal.multiTask THEN 
  2669.     (* Bildschirm freigeben und alle Menus sperren 
  2670.      *)
  2671.     MagicAES.WindUpdate (MagicAES.ENDUPDATE);
  2672.   END;
  2673.   IF inBits IN what THEN
  2674.     found := FindWithBits(break);
  2675.   ELSE
  2676.     found := FindStringOnly(break);
  2677.   END;
  2678.   IF CatGlobal.multiTask
  2679.   THEN
  2680.     (* MagicAES.WindUpdate wieder setzen und Menu wieder anschalten *)
  2681.     MagicAES.WindUpdate (MagicAES.BEGUPDATE);
  2682.   END;
  2683.   mtAppl.RestoreMouse();
  2684.   nr := start;
  2685.   Find2.Dispose (pPatt);   Find2.Dispose (pPatt2); 
  2686.   Find2.Dispose (pPatt3);  Find2.Dispose (pPatt4);
  2687.   isInSearch := FALSE;
  2688.   RETURN found;
  2689. END ComplexSearch;
  2690.  
  2691. (*--- Schreibprozeduren ---*)
  2692.  
  2693. PROCEDURE Abort(which : CARDINAL; crcError : BOOLEAN; nr, group : CARDINAL);
  2694. (* Abbruchprozedur fr AppendMessage & InserKom *)
  2695. VAR scrap : CatTypes.String255;
  2696. BEGIN
  2697.   CatLog.WriteLine('- data.i meldet sich wg. Dateifehler -');
  2698.   CatLog.WriteString('Dateifehler beim Einfgen in die Gruppe ');
  2699.   GroupSelect.GroupName(group, scrap);
  2700.   CatLog.WriteString(scrap);
  2701.   CatLog.Write('.');
  2702.   CatLog.WriteLn();
  2703.   CatLog.WriteString(' -> Gemdos-Fehler #');
  2704.   CatLog.WriteInt(CatFiles.FileError);
  2705.   CatLog.WriteLn();
  2706.   CatLog.WriteString('Und zwar in der ');
  2707.   CASE which OF
  2708.     0 : CatLog.WriteLine('Crc-Tabelle.');
  2709.   | 1 : CatLog.WriteString('Parameterdatei bei MsgNummer ');
  2710.         CatLog.WriteCard(LONG(nr)); CatLog.Write('.'); CatLog.WriteLn();
  2711.   | 2 : CatLog.WriteLine('Daten-Hauptdatei.');
  2712.   END;
  2713.   CatFiles.GetErrorMsg (CatFiles.FileError, scrap);
  2714.   CatLog.WriteString ('Fehlermeldung: ');
  2715.   CatLog.WriteString (scrap);
  2716.   CatLog.WriteLn();
  2717.   IF crcError THEN
  2718.     CatLog.WriteString('Grund: Die Crc der Msg ist falsch.');
  2719.     CatLog.WriteLn();
  2720.   END;
  2721.   CatLog.WriteLine('Daher wurde das Einfgen abgebrochen.');
  2722.   CatLog.WriteLine('- Ende der Durchsage -');
  2723.   CatFiles.ErrorAlert(CatFiles.FileError);
  2724. END Abort;
  2725.  
  2726. PROCEDURE InsertKom(handle : OneGroupHandle; 
  2727.                     MessageNummer : CARDINAL;
  2728.                     usenetOnly    : BOOLEAN;
  2729.                 VAR addFlags : BITSET; (* Flags, die wg. Vererben-Flag gesetzt werden sollen *)
  2730.                 VAR upMess, leftMess : CARDINAL;
  2731.                 VAR refNr : ARRAY OF CHAR; (* eigentlich reference-parameter *)
  2732.                 VAR abort : BOOLEAN);
  2733. VAR origin, Nr,
  2734.     last, next  : CARDINAL;
  2735.     s           : pBlock;
  2736.     blockPtr    : pBlockPtr;
  2737.     err         : errorType;
  2738.     eindeutig   : BOOLEAN;
  2739.     searchAgain : BOOLEAN;
  2740.     scrapID     : String1023; (* Testen, ob die ID ok ist *)
  2741.     filteredToRead: BOOLEAN;
  2742.  
  2743.   PROCEDURE SearchWithHash(VAR origin : CARDINAL):BOOLEAN;
  2744.   VAR compareCrc  : CARDINAL;
  2745.   BEGIN
  2746.     IF Hashing2.emptyHash(handle^.hash) THEN RETURN FALSE END;
  2747.     (* Keine Hashtabelle, SearchAgain sowieso TRUE, d.h. nochmal suchen *)
  2748.     compareCrc := CalcIdCrc(refNr);
  2749.     origin := Hashing2.GetFirst(handle^.hash, compareCrc);
  2750.     (* Erste Msg mit gesuchter Crc oder empty *)
  2751.     eindeutig := Hashing2.GetNext(handle^.hash) = empty;
  2752.     (* Falls es keinen weiteren gibt, ist es eindeutig *)
  2753.     searchAgain := ~eindeutig;
  2754.     (* nicht eindeutig => nochmal suchen *)
  2755.     (* Sonst haben wir einen Kandidaten, dann nicht nochmal suchen *)
  2756.     RETURN eindeutig & (origin # empty); (* gefunden und eindeutig *)
  2757.   END SearchWithHash;
  2758.   
  2759.   PROCEDURE SearchUsenet(handle  : OneGroupHandle;
  2760.                      VAR search  : ARRAY OF CHAR;
  2761.                      VAR origin  : CARDINAL;
  2762.                      VAR start   : CARDINAL):BOOLEAN;
  2763.   (* Sucht eine Usenet-ID *)
  2764.   VAR id : CatTypes.String255;
  2765.       nr : CARDINAL;
  2766.       isOldDupe : BOOLEAN;
  2767.   BEGIN
  2768.     nr := start;
  2769.     WHILE nr < CARDINAL(-1) DO
  2770.       IF ReadOtherRId(handle, nr, id, isOldDupe) THEN
  2771.         (* IF MagicStrings.Equal(id, search) THEN *)
  2772.         IF AssFuncs.CmpId(id, search) THEN
  2773.           origin := nr;
  2774.           RETURN TRUE;
  2775.         END;
  2776.       END;
  2777.       DEC(nr);
  2778.     END;
  2779.     RETURN FALSE
  2780.   END SearchUsenet;
  2781.  
  2782. BEGIN
  2783.   addFlags := {}; (* erstmal nix *)
  2784.   (* Erstmal initialisieren, dann kann man ohne Probleme RETURNen *)
  2785.   upMess   := notSaved;
  2786.   leftMess := empty;
  2787.   eindeutig := FALSE;
  2788. (*  abort := FALSE; *)
  2789.   (* Ist die crc eindeutig? Dann beim Herstellen der Verkettung die ID untersuchen *)
  2790.   searchAgain := TRUE;
  2791.  
  2792.   IF (usenetOnly & SearchUsenet(handle, refNr, origin, MessageNummer)) OR
  2793.      (~usenetOnly & 
  2794.        ( 
  2795.          SearchWithHash(origin) OR 
  2796.          (searchAgain & SearchID(handle, refNr, 0, TRUE, TRUE, origin)) 
  2797.        )
  2798.      )
  2799.   THEN
  2800.                                                      (* Zur neuesten verketten ^^^^ *)
  2801. (* Erl„uterung: Der erste Term ist falsch, wenn entweder keine Hashtabelle da ist *)
  2802. (* oder aber dort die gesuchte Crc nicht gefunden wurde oder sie nicht eindeutig  *)
  2803. (* ist. Falls sie nicht eindeutig ist, oder keine Hashtabelle da ist, soll nach   *)
  2804. (* alten Methode gesucht werden.                                                  *)
  2805.     blockPtr := ADR(s);
  2806.     err := ReadBlockCrc(handle, origin, blockPtr); (* Hier Fehlerbehandlung!! *)
  2807.     IF err # noError THEN Abort(1, err = crcError, origin, handle^.group); abort := TRUE; RETURN END;
  2808.     
  2809.     IF bVererben IN blockPtr^.bits THEN
  2810.     (* hier wird berprft, ob die Muttermsg das Vererben-Flag hat und wenn ja, *)
  2811.     (* dann werden alle Flags an die Tochtermsg weitergegeben                   *)
  2812.       addFlags := blockPtr^.bits - {bGelesen, bKommentieren, bAntworten, bOwnMessage, bComToOwnMessage};
  2813.       IF (bFiltered IN addFlags) 
  2814.       THEN
  2815.         ConfVars.GetConfDefBool (cFilteredRead, filteredToRead, FALSE);
  2816.         IF filteredToRead
  2817.         THEN 
  2818.           INCL (addFlags, bGelesen);
  2819.         END;
  2820.       END;
  2821.     END;
  2822.  
  2823.     IF bOwnMessage IN blockPtr^.bits THEN
  2824.       (* Kommentare auf eigene Nachrichten erhalten ein spezielles Flag *)
  2825.       INCL (addFlags, bComToOwnMessage);
  2826.       (* Jetzt noch merken, daž es in dieser Gruppe Kommentare auf 
  2827.        * eigene Nachrichten gab 
  2828.        *)
  2829.       
  2830.     END;
  2831.  
  2832.     IF eindeutig THEN
  2833.     (* Falls die Crc eindeutig war, muž noch die ID selber berprft werden *)
  2834.       ReadID(handle, blockPtr^.Start, blockPtr^.idLength, scrapID);
  2835.       IF error # noError THEN Abort(2, error = crcError, origin, handle^.group); abort := TRUE; RETURN END;
  2836.  
  2837.       (* IF ~MagicStrings.Equal(scrapID, refNr) THEN *)
  2838.       IF ~AssFuncs.CmpId (scrapID, refNr) THEN
  2839.         RETURN
  2840.       END;
  2841.     END;
  2842.  
  2843.     upMess := origin;
  2844.     Nr     := origin; (* Fr's Schreiben unten *)
  2845.     IF (blockPtr^.downMess = empty) OR (blockPtr^.downMess <= origin) THEN
  2846.       (* Im zweiten Fall w„r's ein Verkettungsfehler -> anmeckern *)
  2847.       blockPtr^.downMess := MessageNummer;
  2848.       blockPtr^.KomCount := 1;
  2849.       leftMess           := empty;
  2850.     ELSE (* blockPtr^.downMess # empty *)
  2851.       (* Jetzt beim ersten Kommentar, nach rechts bis zum Ende gehen *)
  2852.  
  2853.       last := origin; (* Ursprungmsg, bzw. kommentierte Msg *)
  2854.       next := blockPtr^.downMess;
  2855.       INC(blockPtr^.KomCount); (* Jetzt haben wir einen Kommentar mehr *)
  2856. (*      blockPtr^.crc := CalcCrcArray(blockPtr+ADDRESS(2), SHORT(TSIZE(pBlock))-2); *)
  2857.       WriteBlockCrc(handle, origin, blockPtr);
  2858.       IF error # noError THEN Abort(1, err = crcError, origin, handle^.group); abort := TRUE; RETURN END;
  2859.  
  2860.       (* ..und jetzt suchen, bis wir am Ende des Kommentarbaumes sind *)
  2861.       WHILE (last < next) & (next < handle^.anz) & (next # empty) DO
  2862.         blockPtr := ADR(s);
  2863.         err  := ReadBlockCrc(handle, next, blockPtr); (* Fehlerbehandlung..! *)
  2864.         IF err # noError THEN Abort(1, err = crcError, next, handle^.group); abort := TRUE; RETURN END;
  2865.         last := next;
  2866.         next := blockPtr^.rightMess
  2867.       END;
  2868.       (* Verkettungsfehler anmeckern *)
  2869.       Nr := last;
  2870.       blockPtr^.rightMess := MessageNummer;
  2871.       leftMess            := Nr;
  2872.     END;
  2873. (*    blockPtr^.crc := CalcCrcArray(blockPtr+ADDRESS(2), SHORT(TSIZE(pBlock))-2);*)
  2874.     WriteBlockCrc(handle, Nr, blockPtr);
  2875.     IF error # noError THEN Abort(1, error = crcError, Nr, handle^.group); abort := TRUE; RETURN END;
  2876.   END
  2877. END InsertKom;
  2878.  
  2879. (*
  2880. CONST bId    = 0;  bRefNr  = 1;  bVon    = 3;  bAn  = 4;  bWegen = 5;
  2881.       bEZeit = 6;  bGruppe = 7;  bBSZeit = 8;  bMId = 9;  bRId   = 10;
  2882.       bBox   = 11; bName   = 12; bText   = 13; bTextDatei = 14;
  2883.  
  2884. TYPE PtrRecord =
  2885.        RECORD
  2886.          whatsThere : BITSET;
  2887.          pId,                   (* Maus-ID der Mitteilung               *)
  2888.          pRefNr,   pVon,        (* kommentierte Msg,    Absender        *)
  2889.          pAn,      pWegen,      (* Empf„nger,           Betreff         *)
  2890.          pEZeit,   pGruppe,     (* Eingabezeit,         Gruppe          *)
  2891.          pBSZeit,  pMId,        (* Bearb.status+Zeit,   MessageID       *)
  2892.          pRId,     pBox,        (* RId gem. Def.,       Box gem. Def.   *)
  2893.          pName   : Str1023Ptr;  (* Name gem. Def falls # Absenderangabe *)
  2894.          pText   : BigTextPtr;  (* MsgText      *)
  2895.          TextMax : CARDINAL;
  2896.          txt     : mtTextfiles.TEXTFILE;
  2897.        END;
  2898. *)
  2899.  
  2900. (*TYPE WhatsThat = (own, personal, status, normal, garbage);*)
  2901.  
  2902. PROCEDURE PreCheck(VAR mess : PtrRecord):WhatsThat;             (* exported *)
  2903. (* Testet die Nachricht einmal durch, damit der parser schon einen Teil der *)
  2904. (* Fehlerbehandlung sowie die WatchDog-Behandlung machen kann               *)
  2905. BEGIN
  2906.   (* Pers”nliche Nachricht? *)
  2907.   IF (stringSet{bVon, bAn, bWegen, bEZeit,          bBSZeit, bText} - mess.whatsThere = stringSet{}) & 
  2908.       ~(bGruppe IN mess.whatsThere) THEN RETURN personal
  2909.   ELSIF (* Eigene, pers”nliche Nachricht *)
  2910.     (stringSet{      bAn, bWegen, bEZeit,                 bTextDatei} - mess.whatsThere = stringSet{}) &
  2911.             ~(bGruppe IN mess.whatsThere) THEN RETURN own
  2912.   ELSIF (* Normale Gruppen-Nachricht? *)
  2913.     (stringSet{           bWegen, bEZeit, bGruppe,          bText}          - mess.whatsThere = stringSet{}) 
  2914.             (*& ~(bBSZeit IN mess.whatsThere) wg. "RAUS" *)THEN RETURN normal
  2915.   ELSIF stringSet{bId, bBSZeit, bEZeit} - mess.whatsThere = stringSet{} THEN RETURN status
  2916.   ELSE
  2917.     RETURN garbage
  2918.   END;
  2919. END PreCheck;
  2920.  
  2921. PROCEDURE isDupe(handle : OneGroupHandle; VAR mess: PtrRecord; date: LONGCARD; type: WhatsThat):BOOLEAN;
  2922.   VAR nr : CARDINAL; 
  2923.       s : pBlock; 
  2924.       blockPtr : pBlockPtr;
  2925.       oldMess: MessageType;
  2926. BEGIN
  2927.   IF ~SearchID(handle, mess.pId^, 0, TRUE, TRUE, nr) THEN
  2928.     RETURN FALSE
  2929.   ELSE
  2930.     blockPtr := ADR(s);
  2931.     IF ReadBlockCrc(handle, nr, blockPtr) = noError THEN
  2932.       IF (blockPtr^.Datum = date) 
  2933.        & (blockPtr^.Length = mess.TextMax)
  2934.       THEN
  2935.         RETURN TRUE; (* doch'n Dupe *)
  2936.       ELSE
  2937.         IF (type = own) & (blockPtr^.Datum = date)
  2938.         THEN
  2939.           (* Da ist die L„nge noch nicht gesetzt, daher Dupe! *)
  2940.           RETURN TRUE;
  2941.         ELSIF (type = own)
  2942.         THEN
  2943.           (* Mal sehen, ob wir eine MId haben *)
  2944.           IF (bMId IN mess.whatsThere) & (mMId IN blockPtr^.items)
  2945.           THEN
  2946.             (* MId ist da, alte MId lesen *)
  2947.             ReadHeader (handle, nr, oldMess);
  2948.             IF (mess.pMId # NIL)
  2949.              & (oldMess.mid # NIL)
  2950.             THEN
  2951.               IF AssFuncs.CmpId (mess.pMId^, oldMess.mid^) 
  2952.               THEN
  2953.                 DEALLOCATE (oldMess.InfoStrings, 0);
  2954.                 RETURN TRUE;
  2955.               END;
  2956.             END;
  2957.             DEALLOCATE (oldMess.InfoStrings, 0);
  2958.           END;
  2959.         END;
  2960.         INCL(blockPtr^.bits, bOldDupe);
  2961.         WriteBlockCrc(handle, nr, blockPtr);
  2962.         RETURN FALSE; (* Kein Dupe, aber gleiche ID *)
  2963.       END;
  2964.     ELSE
  2965.       RETURN FALSE (* Gibt's einen Dateifehler ist's auch kein Dupe :-) *)
  2966.     END;
  2967.   END;
  2968. END isDupe;
  2969.  
  2970. PROCEDURE AppendMessage(handle : OneGroupHandle;                 (* exported *)
  2971.                         type   : WhatsThat;
  2972.                         bitWishes : BITSET;
  2973.     (* Bits, die beim Einfgen schon gesetzt werden sollen; bFiltered bisher *)
  2974.                     VAR mess   : PtrRecord;
  2975.                     VAR usenetChain, usenetOk : BOOLEAN;
  2976.                     VAR isOneDupe: BOOLEAN;
  2977.                     VAR abort  : BOOLEAN):BOOLEAN;
  2978. (* Eine Message bearbeiten/ abort -> sofort abbrechen, schwerer Fehler *)
  2979. (* Returnwert zeigt an, ob die Nachricht geschrieben wurde *)
  2980. (* Es k”nnen natrlich nur die Typen own, personal, status und normal geschrieben *)
  2981. (* werden. Bei Mižbrauch: Garbage in possible crash out! *)
  2982. (* Eine Message bearbeiten/ abort -> sofort abbrechen, schwerer Fehler *)
  2983. (* Rckgabe, ob sie geschrieben wurde *)
  2984. VAR block : pBlock;
  2985.     z     : CARDINAL;
  2986.     CRC   : CARDINAL;
  2987.     pInfo : pInfoType;
  2988.     pDupe : dupeInfoPtr; (* Fr redundante Daten in der *.DAT *)
  2989.     len,
  2990.     l2    : ARRAY[0..32] OF CARDINAL; (* Darein kommt der L„ngen-Header *)
  2991.     lauf  : stringTypes;
  2992.     str   : Str1023Ptr;  (* Allzweckpointer.. *)
  2993.     saveChar : CHAR;
  2994.     saveCh2  : CHAR;
  2995.     ptRId    : CatTypes.Str1023Ptr;
  2996.     inserted : BOOLEAN;  (* Flag, ob Nachricht mit RId eingefgt wurde,
  2997.                           * ansonsten wird noch Wildwest versucht *)
  2998.     charPos  : CARDINAL; (* beides fr die Kommentarverkettung per RId *)
  2999.     ptPos    : CARDINAL; (* ebenfalls fr RId-Verkettung *)
  3000.     addBits  : BITSET;   (* Zus„tzlich zu setzende Bits, die wg. VererbenFlag von der *)
  3001.                          (* Muttermsg bernommen werden sollen                        *)
  3002.  
  3003.   PROCEDURE Transfer(VAR len : CARDINAL; txt : mtTextfiles.TEXTFILE);
  3004.   (* Text aus Textdatei in die Datenbank packen *)
  3005.   VAR scrap : CatTypes.String1023; 
  3006.       scrap2: CatTypes.String1023;
  3007.       l     : CARDINAL;
  3008.       tabSize: INTEGER;
  3009.   BEGIN
  3010.     ConfVars.GetConfDefInt (cTabsize, tabSize, 4);
  3011.     len := 0;
  3012.     REPEAT
  3013.       mtTextfiles.ReadLine(txt, scrap);
  3014.       mtTextfiles.ReadLn(txt);
  3015.       CatGlobal.ConvertTabs (scrap, scrap2, tabSize);
  3016.       l := LENGTH(scrap2);
  3017.       scrap2[l] := LF;
  3018.       INC(l, 1);
  3019.       AppendToDat(handle, ADR(scrap2), LONG(l), v.lcard);
  3020.       INC(len, l);
  3021.     UNTIL mtTextfiles.EndofText(txt) OR (CatFiles.FileError < 0);
  3022.   END Transfer;
  3023.  
  3024.   PROCEDURE Str2Ptr(str : stringTypes):ADDRESS;
  3025.   BEGIN
  3026.     CASE str OF
  3027.       bWegen        : RETURN mess.pWegen; |
  3028.       bVon          : RETURN mess.pVon; |
  3029.       bAn           : RETURN mess.pAn; |
  3030.       bMId          : RETURN mess.pMId; |
  3031.       bRId          : RETURN mess.pRId; |
  3032.       bBox          : RETURN mess.pBox; |
  3033.       bName         : RETURN mess.pName; |
  3034.       bRefNr        : RETURN mess.pRefNr; |
  3035.       bDistribution : RETURN mess.pDistribution; |
  3036.       bGate         : RETURN mess.pGate; |
  3037.       bMime         : RETURN mess.pMime; |
  3038.       bFollowupTo   : RETURN mess.pFollowupTo; |
  3039.       bReplyTo      : RETURN mess.pReplyTo; |
  3040.       bSender       : RETURN mess.pSender; |
  3041.     ELSE
  3042.       HALT;
  3043.     END;
  3044.     
  3045.   END Str2Ptr;
  3046.  
  3047.   PROCEDURE item(str : stringTypes):CARDINAL;
  3048.   BEGIN
  3049.     CASE str OF 
  3050.       bVon   : RETURN mVon; |
  3051.       bAn    : RETURN mAn; |
  3052.       bMId   : RETURN mMId; |
  3053.       bRId   : RETURN mRId; |
  3054.       bBox   : RETURN mBox; |
  3055.       bName  : RETURN mName; |
  3056.       bRefNr : RETURN mRefNr; |
  3057.       bGate  : RETURN mGate; |
  3058.       bMime  : RETURN mMime; |
  3059.       bFollowupTo   : RETURN mFollowup; |
  3060.       bReplyTo: RETURN mReplyTo; |
  3061.       bSender: RETURN mSender; |
  3062.       bDistribution : RETURN mDistribution; |
  3063.     ELSE
  3064.       HALT;
  3065.     END;
  3066.   END item;
  3067.  
  3068.   PROCEDURE isMouse(ptr : ADDRESS):BOOLEAN;
  3069.   VAR p : CatTypes.Str255Ptr;
  3070.   BEGIN
  3071.     p := ptr;
  3072.     RETURN MagicStrings.Equal(p^, ".maus.de")
  3073.   END isMouse;
  3074.  
  3075. BEGIN
  3076.   usenetChain := FALSE; usenetOk := FALSE;
  3077.   isOneDupe := FALSE;
  3078.   (* default: Keine Usenetverkettung, hat also auch nicht geklappt *)
  3079.   abort := FALSE; (* Es geht nichts schief.. :-) *)
  3080. (* bId sollte immer gesetzt sein *)
  3081.  
  3082.   IF type = status THEN  (**  Statusmeldung **)
  3083.     IF SearchID(handle, mess.pId^, 0, TRUE, TRUE, z) THEN
  3084.       SetState(handle, z, mDateStr2Long(mess.pBSZeit^, 1), mess.pBSZeit^[0]);
  3085.     END;
  3086.   ELSIF (type = personal) OR (type = normal) OR (type = own) THEN
  3087.     WITH mess DO
  3088.     WITH block DO
  3089.       (* Die crc-Prfsumme ber den Block wird weiter unten berechnet *)
  3090.       IF bEZeit IN whatsThere THEN
  3091.         Datum  := mDateStr2Long(pEZeit^, 0);
  3092.       ELSE
  3093.         Datum := ConvertDate.CurrentDate();
  3094.         (*
  3095.         GetActualDate(Datum);
  3096.         *)
  3097.       END;
  3098.       (* Das Datum wird fr den Dupecheck jetzt schon ben”tigt. *)
  3099.     END;
  3100.     END;
  3101.  
  3102. (*    IF isDupe(handle, mess.pId^, block.Datum, type) THEN *)
  3103.     IF isDupe(handle, mess, block.Datum, type) THEN
  3104.       IF (type # own)
  3105.       THEN
  3106.         CatLog.WriteStringNTime(mess.pId^);
  3107.         CatLog.WriteLine(' ist ein Dupe und wird nicht eingefgt');
  3108.       END;
  3109.       isOneDupe := TRUE;
  3110.       RETURN FALSE
  3111.     END;
  3112.  
  3113.  
  3114.     WITH mess DO
  3115.     WITH block DO
  3116.       (* Die crc-Prfsumme ber den Block wird weiter unten berechnet *)
  3117.       bits   := bitWishes;
  3118.       (* Erst einmal sicherheitshalber zuweisen *)
  3119.       upMess  := empty;
  3120.       leftMess:= empty;
  3121.       addBits := {};
  3122.       IF bRefNr IN whatsThere THEN (* Jetzt evtl. Kommentarverkettung *)
  3123.         InsertKom(handle, handle^.anz, FALSE, addBits, upMess, leftMess, pRefNr^, abort);
  3124.         IF abort THEN RETURN FALSE END;
  3125.       ELSIF bRId IN whatsThere THEN
  3126.         (* Zuerst die Position vom @ finden *)
  3127.         inserted := FALSE;
  3128.         charPos := MagicStrings.Pos('@', pRId^, 0, FALSE);
  3129.         IF charPos < TSIZE(CatTypes.String255) THEN
  3130.           charPos := MagicStrings.Pos('.', pRId^, charPos, FALSE);
  3131.           IF (charPos < TSIZE(CatTypes.String255)) & 
  3132.              (isMouse(ADDRESS(pRId)+ADDRESS(LONG(charPos))))
  3133.           THEN
  3134.             saveChar := pRId^[charPos];
  3135.             pRId^[charPos] := 0C; (* das xxx.maus.de abschneiden *)
  3136.             (* Neue IDs (kann ich von ausgehen!), jetzt vorne Teil vor . suchen *)
  3137.             ptPos := MagicStrings.Pos ('.', pRId^, 0, FALSE);
  3138.             IF ptPos < TSIZE (CatTypes.String255)
  3139.             THEN
  3140.               (* . vorne gefunden, wir setzen den Zeiger dahinter! *)
  3141.               ptRId := ADDRESS (pRId) + ADDRESS(LONG(ptPos+1)); 
  3142.               saveCh2 := ptRId^[0];
  3143.               ptRId^[0] := CAP(ptRId^[0]);
  3144.             ELSE
  3145.               ptRId := ADDRESS(pRId);
  3146.               saveCh2 := 0c;
  3147.             END;
  3148.             (* Und jetzt Kommentar einfgen *)
  3149.             InsertKom(handle, handle^.anz, FALSE, addBits, upMess, leftMess, ptRId^, abort);
  3150.             inserted := TRUE;
  3151.             pRId^[charPos] := saveChar; (* ..und wieder herstellen.. *)
  3152.             IF saveCh2 # 0c
  3153.             THEN
  3154.               ptRId^[0] := saveCh2;
  3155.             END; 
  3156.           ELSIF usenetChaining THEN (* soll die Usenetverkettung hergestellt werden? *) 
  3157.             usenetChain := TRUE;
  3158.             InsertKom(handle, handle^.anz, TRUE, addBits, upMess, leftMess, pRId^, abort);
  3159.             (* Verkettung mit Usenet-ID herstellen, langsam.. *)
  3160.             usenetOk := upMess # notSaved;
  3161.             inserted := usenetOk;
  3162.           END;
  3163.         END;
  3164.         (* Neu fr Wildwestverkettungen bei Mails mit RId *)
  3165.         IF ~inserted & (bText IN whatsThere) & PrepareID(ADDRESS(pText), str, saveChar, charPos) THEN
  3166.           (* Verkettung anhand der ersten Msgzeile, nur fr den Notfall, deswegen *)
  3167.           (* hier am Ende, mit niedrigster Priorit„t.                             *)
  3168.           InsertKom(handle, handle^.anz, FALSE, addBits, upMess, leftMess, str^, abort);
  3169.           str^[charPos] := saveChar; (* wurde in diesem Fall in PrepareID ge„ndert. *)
  3170.         END;
  3171.       ELSIF (bText IN whatsThere) & PrepareID(ADDRESS(pText), str, saveChar, charPos) THEN
  3172.         (* Verkettung anhand der ersten Msgzeile, nur fr den Notfall, deswegen *)
  3173.         (* hier am Ende, mit niedrigster Priorit„t.                             *)
  3174.         (* Schneller als Usenet-Verkettung, aber Usenetter haben diese Zeile nicht! *)
  3175.         InsertKom(handle, handle^.anz, FALSE, addBits, upMess, leftMess, str^, abort);
  3176.         str^[charPos] := saveChar; (* wurde in diesem Fall in PrepareID ge„ndert. *)
  3177.       END;
  3178.       bits      := bits + addBits; (* Vererben-Flag *)
  3179.       downMess  := empty;
  3180.       rightMess := empty;
  3181.       KomCount  := 0;
  3182.  
  3183.   (* Hier wird der Header in der *.DAT erstellt *)
  3184.       idLength := LENGTH(pId^)+1;
  3185.       hLength  := idLength;
  3186.       IF ODD(hLength) THEN INC(hLength) END;
  3187.       (* Damit man auf die Tabelle auch auf 68000 zugreifen kann *)
  3188.       (* Zun„chst einmal zur Sicherheit, das kann man sp„ter ja  *)
  3189.       (* auch ohne Code„nderung wieder weglassen                 *)
  3190.       AppendToDat(handle, pId, LONG(hLength), Start);
  3191.       IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(2, FALSE, 0, handle^.group); RETURN FALSE; END;
  3192.  
  3193.       items := {};
  3194. (* Hier kommt jetzt die Tabelle der L„ngen hin *)
  3195.       l2[1] := hLength;
  3196.       len[0] := 0; (* Anzahl der Strings, Wegen ist da! *)
  3197.       FOR lauf := bWegen TO bSender DO
  3198.         (* bWegen, bVon, bAn, bMId, bRId, bBox, bName, bRefNr, bDistribution, bGate, bMime, bFollowupTo, bReplyTo, bSender *)
  3199.         IF lauf IN whatsThere THEN
  3200.           INC(len[0]);          (* Wieder einen String gefunden *)
  3201.           str := Str2Ptr(lauf); (* Pointer abrufen *)
  3202.           z := LENGTH(str^)+1;  (* L„nge inklusive Nullbyte bestimmen *)
  3203.           INC(hLength, z);      (* der Header ist l„nger geworden *)
  3204.           len[len[0]] := z;     (* Stringl„nge merken *)
  3205.           IF lauf # bWegen THEN
  3206.             INCL(items, item(lauf)); (* und auch im Parameterblock merken *)
  3207.           END;
  3208.         END;
  3209.       END;
  3210.       (* DEBUG: DIE LŽNGEN SIND KORREKT *)
  3211.       (* L„nge der Tabelle auf die Startposition addieren: *)
  3212.       INC(l2[1], (len[0]+1)*2); (* hLength steht schon drin *)
  3213.       INC(hLength, (len[0]+1)*2);
  3214.       l2[0] := len[0];
  3215.       FOR z := 2 TO len[0] DO
  3216.         l2[z] := len[z-1] + l2[z-1]; (* aus L„ngen Startpositionen machen *)
  3217.       END;
  3218.       AppendToDat(handle, ADR(l2), LONG(len[0]+1)*2, v.lcard);
  3219.       (* Tabelle mit den StringL„ngen *)
  3220.       IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(2, FALSE, 0, handle^.group); RETURN FALSE; END;
  3221.  
  3222.  
  3223.  
  3224. (* Evtl. noch ber einen Puffer laufen lassen?  *)
  3225. (* Da aber evtl. die Ausgabe schon gepuffer ist *)
  3226. (* macht das auch nicht mehr viel aus           *)
  3227.       z := 1; (* Position in len *)
  3228.       FOR lauf := bWegen TO bSender DO
  3229.         (* bWegen, bVon, bAn, bMId, bRId, bBox, bName, bRefNr, bDistribution, bGate, bMime, bFollowupTo, bReplyTo, bSender *)
  3230.         IF lauf IN whatsThere THEN
  3231.           AppendToDat(handle, Str2Ptr(lauf), LONG(len[z]), v.lcard);
  3232.           IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(2, FALSE, 0, handle^.group); RETURN FALSE; END;
  3233.           INC(z);
  3234.         END;
  3235.       END;
  3236.  
  3237.     (* Hier mssen notfalls die unbekannten Zeilen verarbeitet werden *)
  3238.  
  3239.     (* ..und hier kommt noch bei privaten die private-Bytes, logisch, nech? Arararahhh *)
  3240.  
  3241.       IF handle^.group = private THEN
  3242.         IF type = personal THEN
  3243.           pInfo.LeseDatum := mDateStr2Long(pBSZeit^, 1);
  3244.           pInfo.Status := pBSZeit^[0];
  3245.           IF dataSys.bOwnMessage IN bitWishes
  3246.           THEN
  3247.             EXCL (bitWishes, dataSys.bOwnMessage);
  3248.             EXCL (bits, dataSys.bOwnMessage);
  3249.             pInfo.locked := 1C;
  3250.           ELSE
  3251.             pInfo.locked := 0C; (* Da eigene Msgs auch hierher kommen, muž hier nochwas neues her *)
  3252.           END;
  3253.         ELSIF type = own THEN
  3254.           pInfo.LeseDatum := ConvertDate.CurrentDate();
  3255.           (*
  3256.           GetActualDate(pInfo.LeseDatum);
  3257.           *)
  3258.           pInfo.Status := 'N';
  3259.           pInfo.locked := 1C;
  3260.         END;
  3261.         IF ODD(hLength) THEN (* alignen *)
  3262.           INC(hLength);
  3263.           AppendToDat(handle, CADR(fillBytePersonal), 1, v.lcard);
  3264.           IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(2, FALSE, 0, handle^.group); RETURN FALSE; END;
  3265.         END;
  3266.         AppendToDat(handle, ADR(pInfo), TSIZE(pInfoType), v.lcard);
  3267.         IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(2, FALSE, 0, handle^.group); RETURN FALSE; END;
  3268.         INCL(items, mPrivateBytes);
  3269.         INC(hLength, SHORT(TSIZE(pInfoType)));
  3270.       ELSIF bBSZeit IN mess.whatsThere THEN
  3271.         (* Status-Zeile bei OMs bei Laberfilter RAUS *)
  3272.         IF pBSZeit^[0] = 'G' THEN INCL(bits, bGelesen)
  3273.         ELSIF pBSZeit^[0] = 'F' THEN INCL(bits, bFiltered) END;
  3274.       END;
  3275.     (* ..und schon haben wir uns einen sch”nen Header gebastelt *)
  3276.  
  3277.       IF type = own THEN (* Dann steht der Text in einer Datei *)
  3278.         Transfer(Length, txt);
  3279.         IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(2, FALSE, 0, handle^.group); RETURN FALSE END;
  3280.       ELSE               (* Sonst wurde er per Pointer bergeben *)
  3281.         Length := TextMax; (* Auf Nullbyte am Ende achten! *)
  3282.         AppendToDat(handle, pText, LONG(Length), v.lcard);
  3283.         IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(2, FALSE, 0, handle^.group); RETURN FALSE; END;
  3284.       END;
  3285.  
  3286.       CRC := CalcIdCrc(pId^);
  3287.       AppendCrc(handle, CRC);
  3288.       IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(0, FALSE, 0, handle^.group); RETURN FALSE; END;
  3289.  
  3290.       (* Achtung, Reihenfolge mit AppendBlock wg. anz-Erh”hung wichtig *)
  3291.  
  3292.     END; (* WITH block *)
  3293.     END; (* WITH mess *)
  3294.  
  3295.     block.crc := CalcCrcArray(ADR(block)+ADDRESS(2), SHORT(TSIZE(pBlock))-2);
  3296.     (* Neuerdings wird SICHERHEIT grožgeschrieben :-) *)
  3297.  
  3298.     AppendBlock(handle, block); (* .. und an die halbfertige *.PAR anh„ngen *)
  3299.     IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(1, FALSE, handle^.anz, handle^.group); RETURN FALSE; END;
  3300.  
  3301. (* Diese beiden Schreiboperationen mssen evtl. noch umgedreht werden! *)
  3302.     pDupe := ADR(block)+ADDRESS(2);
  3303.     pDupe^.setTerminator := Terminator;
  3304.     AppendToDat(handle, pDupe, TSIZE(dupeInfoType), v.lcard);
  3305.     IF CatFiles.FileError < 0 THEN abort := TRUE; Abort(2, FALSE, 0, handle^.group); RETURN FALSE; END;
  3306.  
  3307.   END; (* ..ELSIF (type = personal) OR (type = normal) OR (type = own) *)
  3308.  
  3309.   RETURN TRUE
  3310. END AppendMessage;
  3311.  
  3312. PROCEDURE dumpMess(mess : PtrRecord);
  3313. (* Fehlermeldung zu dieser Nachricht in catlog.txt ausgeben *)
  3314.   VAR tmp: CatTypes.String255;
  3315.       tPtr: CatTypes.Str1023Ptr;
  3316.       copyLen: CARDINAL;
  3317. BEGIN
  3318.   CatLog.WriteLineNTime('Fehler im Outfile:');
  3319.   (*
  3320.   CatLog.WriteLine('- data.i: Melde mich wg. dingenskirchen -');
  3321.   *)
  3322.   CatLog.WriteLine('illegales OUTFILE-Format');
  3323.   CatLog.WriteLine('folgende Zeilen wurden gefunden:');
  3324.   WITH mess DO
  3325.     IF bId     IN whatsThere THEN CatLog.WriteString('Id    : '); CatLog.WriteLine(pId^); END;
  3326.     IF bRefNr  IN whatsThere THEN CatLog.WriteString('RefNr : '); CatLog.WriteLine(pRefNr^); END;
  3327.     IF bVon    IN whatsThere THEN CatLog.WriteString('Von   : '); CatLog.WriteLine(pVon^); END;
  3328.     IF bAn     IN whatsThere THEN CatLog.WriteString('An    : '); CatLog.WriteLine(pAn^); END;
  3329.     IF bWegen  IN whatsThere THEN CatLog.WriteString('Wegen : '); CatLog.WriteLine(pWegen^); END;
  3330.     IF bEZeit  IN whatsThere THEN CatLog.WriteString('EZeit : '); CatLog.WriteLine(pEZeit^); END;
  3331.     IF bGruppe IN whatsThere THEN CatLog.WriteString('Gruppe: '); CatLog.WriteLine(pGruppe^); END;
  3332.     IF bBSZeit IN whatsThere THEN CatLog.WriteString('BSZeit: '); CatLog.WriteLine(pBSZeit^); END;
  3333.     IF bMId    IN whatsThere THEN CatLog.WriteString('MId   : '); CatLog.WriteLine(pMId^); END;
  3334.     IF bRId    IN whatsThere THEN CatLog.WriteString('RId   : '); CatLog.WriteLine(pRId^); END;
  3335.     IF bBox    IN whatsThere THEN CatLog.WriteString('Box   : '); CatLog.WriteLine(pBox^); END;
  3336.     IF bName   IN whatsThere THEN CatLog.WriteString('Name  : '); CatLog.WriteLine(pName^); END;
  3337.     IF bGate   IN whatsThere THEN CatLog.WriteString('Gate  : '); CatLog.WriteLine(pGate^); END;
  3338.     IF bMime   IN whatsThere THEN CatLog.WriteString('MIME  : '); CatLog.WriteLine(pMime^); END;
  3339.     IF bFollowupTo IN whatsThere THEN CatLog.WriteString('Followup-To: '); CatLog.WriteLine(pFollowupTo^); END;
  3340.     IF bReplyTo IN whatsThere THEN CatLog.WriteString('Reply-To: '); CatLog.WriteLine(pReplyTo^); END;
  3341.     IF bSender  IN whatsThere THEN CatLog.WriteString('Sender  : '); CatLog.WriteLine(pSender^); END;
  3342.     IF bDistribution IN whatsThere THEN CatLog.WriteString('Distr.: '); CatLog.WriteLine(pDistribution^); END;
  3343.     IF bText   IN whatsThere THEN 
  3344.       CatLog.WriteLine('Text gefunden:'); 
  3345.       tPtr := ADDRESS(pText);
  3346.       copyLen := BinOps.LowerCard (TextMax, 230);
  3347.       Strings.Copy (tPtr^, 0, copyLen, tmp, v.bool);
  3348.       CatLog.WriteLine (tmp);
  3349.     END;
  3350.     IF bTextDatei IN whatsThere THEN CatLog.WriteLine('Text in Datei bergeben'); END;
  3351.   END;
  3352.   CatLog.WriteLine('- data.i: Ende der Durchsage -------------');
  3353.   (*
  3354.   MTE.warnAlert(mtAlerts.Alert(1, MTE.coreDumped) = 2, MTE.translation, '', '');
  3355.   *)
  3356. END dumpMess;
  3357.  
  3358. PROCEDURE Dxreaddir (handle : lINTEGER; VAR name : ARRAY OF CHAR; 
  3359.                      VAR xattr : FileSys.XATTR; VAR xr: lINTEGER) : lINTEGER;
  3360.   VAR res: lINTEGER;
  3361. BEGIN
  3362.   res := Mintbind.Dxreaddir (handle, name, xattr, xr);
  3363.   IF res = LONG(MagicDOS.EInvFN)
  3364.   THEN
  3365.     res := Mintbind.Dreaddir (handle, name);
  3366.     xr := Mintbind.Fxattr (0, name, xattr);
  3367.   END;
  3368.   RETURN res;
  3369. END Dxreaddir;
  3370.  
  3371. PROCEDURE EstimateNecessaryMemory():LONGCARD;
  3372. (* Versucht den fr den n„chsten Einfgevorgang n”tigen Platz zu sch„tzen *)
  3373. VAR myDTA      : MagicDOS.DTA;
  3374.     oDta       : ADDRESS;
  3375.     maxTab,
  3376.     maxPar,
  3377.     maxAmount  : LONGCARD;
  3378.     tmp,
  3379.     mask       : CatTypes.String1023;
  3380.     toLower    : BOOLEAN;
  3381.     firstFound : BOOLEAN;
  3382.     nr         : CARDINAL;
  3383.     dHandle    : LONGINT;
  3384.     nPtr       : CatTypes.Str1023Ptr;
  3385.     xattr      : FileSys.XATTR;
  3386.     err        : LONGINT;
  3387.     xattrErr   : LONGINT;
  3388.  
  3389.   PROCEDURE isExt(REF e : ARRAY OF CHAR):BOOLEAN;
  3390.   VAR z : CARDINAL;
  3391.   BEGIN
  3392.     WITH myDTA DO
  3393.       z := LENGTH(dFname);
  3394.       RETURN ((z = 11) OR (z = 12)) &
  3395.         (dFname[z-1] = e[3]) & (dFname[z-2] = e[2]) &
  3396.         (dFname[z-3] = e[1]);
  3397.     END;
  3398.   END isExt;
  3399.  
  3400. BEGIN
  3401.   maxAmount := 0;
  3402.   nr := 0;
  3403.   IF CatGlobal.isMintDomain
  3404.   THEN
  3405.     (* case-sensitivity vom filesystem feststellen *)
  3406.     (* Zugriff ber Dopendir, Dreaddir *)
  3407.     maxPar := 0;  
  3408.     maxTab := 0;  
  3409.     dHandle := Mintbind.Dopendir (DataPath, 0);
  3410.     IF dHandle >= 0
  3411.     THEN
  3412.       nPtr := ADR (mask[4]);
  3413.       firstFound := TRUE;
  3414.       toLower    := TRUE;
  3415.       REPEAT
  3416.         err := Dxreaddir (dHandle, mask, xattr, xattrErr);
  3417.         IF err = 0
  3418.         THEN
  3419.           IF firstFound 
  3420.           THEN
  3421.             (* Get attributes of file, follow link *)
  3422.             MagicStrings.Assign (DataPath, tmp);
  3423.             MagicStrings.Append (nPtr^, tmp);
  3424.             toLower := 0 # (Mintbind.Dpathconf (tmp, 6));
  3425.             firstFound := FALSE;
  3426.           END;
  3427.           IF toLower
  3428.           THEN
  3429.             Strings.Lower (nPtr^);
  3430.           END;
  3431.           (* Compare name, in den ersten 4 Bytes steht der inode *)
  3432.           IF WildCards.NameMatching (nPtr^, parWild)
  3433.           THEN
  3434.             (* Get attributes of file, follow link *)
  3435.             (*
  3436.             MagicStrings.Assign (DataPath, tmp);
  3437.             MagicStrings.Append (nPtr^, tmp);
  3438.             err := Mintbind.Fxattr (0, tmp, xattr);
  3439.             *)
  3440.             IF xattrErr = 0
  3441.             THEN 
  3442.               maxPar := BinOps.HigherLCard (maxPar, LONGCARD (xattr.size));
  3443.             END;
  3444.           ELSIF WildCards.NameMatching (nPtr^, tabWild)
  3445.           THEN
  3446.             (* Get attributes of file, follow link *)
  3447.             (*
  3448.             MagicStrings.Assign (DataPath, tmp);
  3449.             MagicStrings.Append (nPtr^, tmp);
  3450.             err := Mintbind.Fxattr (0, tmp, xattr);
  3451.             *)
  3452.             IF xattrErr = 0
  3453.             THEN 
  3454.               maxTab := BinOps.HigherLCard (maxTab, LONGCARD (xattr.size));
  3455.             END;
  3456.           END;
  3457.         END;
  3458.       UNTIL err # 0;
  3459.       IF err # MagicDOS.ENMFil
  3460.       THEN
  3461.         CatFiles.ErrorAlert (SHORT (err));
  3462.       END;
  3463.       v.lint := Mintbind.Dclosedir (dHandle);
  3464.       maxAmount := maxTab + maxPar;
  3465.     ELSE
  3466.       CatFiles.ErrorAlert (SHORT (dHandle));
  3467.       maxAmount := 32000;   (* min size *)
  3468.     END;
  3469.   ELSE
  3470.     oDta := MagicDOS.Fgetdta ();
  3471.     MagicDOS.Fsetdta (ADR(myDTA));
  3472.     MagicStrings.Assign (DataPath, mask);
  3473.     MagicStrings.Append(allWild, mask);
  3474.     firstFound := MagicDOS.Fsfirst (mask, {}) = 0;
  3475.     maxPar := 0;  
  3476.     maxTab := 0;  
  3477.     IF firstFound THEN
  3478.       REPEAT
  3479.         Strings.Lower (myDTA.dFname);
  3480.         IF WildCards.NameMatching (myDTA.dFname, parWild)
  3481.         THEN
  3482.           maxPar := BinOps.HigherLCard (maxPar, myDTA.dLength);
  3483.         ELSIF WildCards.NameMatching (myDTA.dFname, tabWild)
  3484.         THEN
  3485.           maxTab := BinOps.HigherLCard (maxTab, myDTA.dLength);
  3486.         END;
  3487.       UNTIL MagicDOS.Fsnext() # 0;
  3488.     END;
  3489.     maxAmount := maxTab + maxPar;
  3490.     MagicDOS.Fsetdta (oDta);
  3491.   END;
  3492.   RETURN maxAmount + minDatBuffer + TSIZE(pBlock)*additional + TSIZE(CARDINAL)*additional;
  3493. END EstimateNecessaryMemory;
  3494.  
  3495.  
  3496. (*$H+*)
  3497. (* --- Baum durchlaufen --- *)
  3498. (*
  3499. TYPE treeProc = PROCEDURE ((* handle: *) OneGroupHandle,
  3500.                            (* msgIdx: *) CARDINAL,
  3501.                            (* mess:   *) pBlockPtr);
  3502. *)
  3503.  
  3504. PROCEDURE WalkTree (handle : OneGroupHandle; mess: CARDINAL; fromTop : BOOLEAN; proc: treeProc);
  3505. (* Allgemeine Prozedur, um einen Baum zu durchlaufen *)
  3506.  
  3507. VAR s  : pBlock;
  3508.     pb : pBlockPtr;
  3509.     idx: CARDINAL;
  3510.     max: CARDINAL;
  3511.     err: errorType;
  3512.  
  3513.   (* Rekursive Prozedur, aber es werden jedesmal nur zwei Bytes auf dem Stack
  3514.    * abgelegt, ansonsten wird auf prozedurglobale Variablen
  3515.    * zugegriffen
  3516.    *)
  3517.   PROCEDURE doWalk (idx : CARDINAL);
  3518.   BEGIN
  3519.     REPEAT
  3520. (*      pb := ADR(s); *)
  3521.       err := ReadBlockCrc (handle, idx, pb);
  3522.       IF err = noError THEN
  3523.         proc (handle, idx, pb);
  3524.         idx := pb^.rightMess;
  3525.         IF (pb^.downMess < empty)  & (pb^.downMess <= max) THEN
  3526.           doWalk (pb^.downMess);
  3527.         END;
  3528.       END;
  3529.     UNTIL (err # noError) OR (idx > max) OR (idx >= empty);
  3530.   END doWalk;
  3531.  
  3532. BEGIN
  3533.   idx := mess;
  3534.   max := handle^.anz;
  3535.   pb := ADR(s);
  3536.   IF max = 0 THEN RETURN ELSE DEC(max) END;
  3537.   IF fromTop THEN
  3538.     (* Erste Nachricht im Baum suchen *)
  3539.     REPEAT
  3540.       err := ReadBlockCrc (handle, idx, pb);
  3541.       IF err = noError THEN
  3542.         IF (pb^.upMess < notSaved) & (pb^.upMess <= max) THEN
  3543.           idx := pb^.upMess
  3544.         END;
  3545.       END;
  3546.     UNTIL (pb^.upMess >= notSaved) OR (err # noError) OR (pb^.upMess > max);
  3547.   END;
  3548.   IF ~fromTop THEN
  3549.   (* nur "runter" l”schen: aktuelle Msg behandeln und dann nur noch Tochtermsgs *)
  3550. (*    pb := ADR(s); *)
  3551.     err := ReadBlockCrc (handle, idx, pb);
  3552.     IF err = noError THEN
  3553.       proc (handle, idx, pb);
  3554.       IF (pb^.downMess < empty) & (pb^.downMess <= max) THEN
  3555.         doWalk (pb^.downMess);
  3556.       END;
  3557.     END;
  3558.   ELSE
  3559.     doWalk (idx);
  3560.   END;
  3561. END WalkTree;
  3562.  
  3563. PROCEDURE WalkTree2 (handle : OneGroupHandle; mess: CARDINAL; maxUp: INTEGER; maxDepth: INTEGER; proc: treeProc);
  3564. (* Etwas weniger allgemeine Prozedur, um einen Baum zu durchlaufen.
  3565.  * Es wird maximal um maxUp Ebenen nach oben gegangen, und von dort aus 
  3566.  * maximal maxDepth Ebenen nach unten 
  3567.  *)
  3568.  
  3569. VAR s  : pBlock;
  3570.     pb : pBlockPtr;
  3571.     idx: CARDINAL;
  3572.     max: CARDINAL;
  3573.     err: errorType;
  3574.     upCount : INTEGER;
  3575.  
  3576.   (* Rekursive Prozedur, aber es werden jedesmal nur zwei Bytes auf dem Stack
  3577.    * abgelegt, ansonsten wird auf prozedurglobale Variablen
  3578.    * zugegriffen
  3579.    *)
  3580.   PROCEDURE doWalk (idx : CARDINAL; depth: INTEGER);
  3581.   BEGIN
  3582.     REPEAT
  3583.       pb := ADR(s);
  3584.       err := ReadBlockCrc (handle, idx, pb);
  3585.       IF err = noError THEN
  3586.         proc (handle, idx, pb);
  3587.         idx := pb^.rightMess;
  3588.         IF (pb^.downMess < empty) & (depth < maxDepth) THEN
  3589.           doWalk (pb^.downMess, depth+1);
  3590.         END;
  3591.       END;
  3592.     UNTIL (err # noError) OR (idx > max) OR (idx >= empty);
  3593.   END doWalk;
  3594.  
  3595. BEGIN
  3596.   idx := mess;
  3597.   max := handle^.anz;
  3598.   IF max = 0 THEN RETURN ELSE DEC(max) END;
  3599.   (* Nach oben gehen, maximal maxUp mal *)
  3600.   upCount := 0;
  3601.   pb := ADR(s);
  3602.   err := ReadBlock (handle, idx, pb);
  3603.   IF err = noError THEN
  3604.     IF pb^.downMess >= notSaved
  3605.     THEN
  3606.       (* In dem Fall korrigieren wir maxUp *)
  3607.       maxUp := maxDepth - 1;
  3608.     END;
  3609.   END;
  3610.   REPEAT
  3611.     pb := ADR(s);
  3612.     err := ReadBlock (handle, idx, pb);
  3613.     IF err = noError THEN
  3614.       IF pb^.upMess < notSaved THEN
  3615.         idx := pb^.upMess
  3616.       END;
  3617.     END;
  3618.     INC (upCount);
  3619.   UNTIL (pb^.upMess >= notSaved) OR (upCount >= maxUp);
  3620.   (* nur "runter" l”schen: aktuelle Msg behandeln und dann nur noch Tochtermsgs *)
  3621.   pb := ADR(s);
  3622.   err := ReadBlockCrc (handle, idx, pb);
  3623.   IF err = noError THEN
  3624.     proc (handle, idx, pb);
  3625.     IF pb^.downMess < empty THEN
  3626.       doWalk (pb^.downMess, 1);
  3627.     END;
  3628.   END;
  3629. END WalkTree2;
  3630.  
  3631.  
  3632. (* --- Prozeduren fr die Flagsbehandlung eines Baumes --- *)
  3633. (*
  3634. TYPE updateProc = PROCEDURE((* msgIndex *) CARDINAL, (* newFlags *) BITSET);
  3635. TYPE flagchangeProc = PROCEDURE( (* oldFlags *) BITSET ) : BITSET;
  3636. *)
  3637.  
  3638. VAR update : updateProc;
  3639. VAR fc     : flagchangeProc;
  3640.  
  3641. PROCEDURE helpTreeDelete(handle : OneGroupHandle; idx : CARDINAL; pb : pBlockPtr);
  3642. VAR newflags : BITSET;
  3643. BEGIN
  3644.   newflags := fc(pb^.bits);
  3645.   IF newflags # pb^.bits THEN
  3646.     pb^.bits := newflags;
  3647.     WriteBlockCrc(handle, idx, pb);
  3648.     update(idx, pb^.bits);
  3649.   END;
  3650. END helpTreeDelete;
  3651.  
  3652. PROCEDURE TreeFlags(handle : OneGroupHandle; mess : CARDINAL; fromTop : BOOLEAN; 
  3653.                     updt : updateProc; flagchange : flagchangeProc);
  3654. (* Flags eines Baumes bearbeiten *)
  3655. BEGIN
  3656.   update := updt; fc := flagchange;
  3657.   WalkTree(handle, mess, fromTop, helpTreeDelete);
  3658. END TreeFlags;
  3659.  
  3660.  
  3661. BEGIN
  3662.   emptyString := '';
  3663.   grPosRead := FALSE;
  3664.   grPos.pos := NIL;
  3665.   isInSearch := FALSE;
  3666.   Lists.CreateList(names, v.bool);
  3667. END data.
  3668.